Suspending 2

File.hs

suspending :: forall i k v. Ord k => Scheduler Monad i i k v
suspending rebuilder tasks target store = fst $ execState (build target) (store, Set.empty)
  where
    build :: k -> State (Store i k v, Set k) ()
    build key = case tasks key of
        Nothing -> return ()
        Just task -> do
            done <- gets snd
            when (key `Set.notMember` done) $ do
                value <- gets (getValue key . fst)
                let newTask :: Task (MonadState i) k v
                    newTask = rebuilder key value task
                    fetch :: k -> State (Store i k v, Set k) v
                    fetch k = do build k                          -- build the key
                                 getValue k . fst <$> get
                    lens :: (Store i k v, Set k) -> (i, i -> (Store i k v, Set k))
                    lens (store, set) = (getInfo store, \i -> (putInfo i store, set))
                newValue <- restate lens newTask fetch
                modify $ \(s, d) -> (updateValue key value newValue s, Set.insert key d)


newtype StateX ii i a = StateX (ReaderT (ii -> (i, i -> ii)) (State ii) a)
    deriving (Functor, Applicative, Monad)

instance MonadState i (StateX ii i) where
    state f = StateX $ ReaderT $ \lens -> state $ \s ->
        let (i, ii) = lens s
            (a, i2) = f i
        in (a, ii i2)

redo :: State ii a -> StateX ii i a
redo = StateX . lift

restate :: forall ii i k v . (ii -> (i, i -> ii)) -> Task (MonadState i) k v -> (k -> State ii v) -> State ii v
restate lens task fetch = StateT $ \ii ->
    let StateX kk = run task (redo . fetch) :: StateX ii i v
    in return $ kk `runReaderT` lens `runState` ii