public
Created

Programmatic translation to iteratees from pull-based code

  • Download Gist
InvertControl.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
{-# LANGUAGE Rank2Types, ImplicitParams #-}
 
import Control.Monad.Reader
import Control.Monad.Trans
 
-- Skip nodes let us do filtering without lookahead
-- uncons is then a simple loop that removes any Skip nodes
data Step a s = Empty | Yield a s | Skip s
 
newtype ListT f a = ListT { runListT :: f (Step a (ListT f a)) }
 
instance Monad f => Monad (ListT f) where
return a = ListT (return (Yield a empty))
(ListT s) >>= f = ListT $
s >>= \step -> case step of
Yield h t -> return $ (Skip $ f h `mplus` (t >>= f))
Skip t -> return $ Skip (t >>= f)
Empty -> return Empty
 
instance (Monad f) => MonadPlus (ListT f) where
mzero = ListT (return Empty)
 
(ListT s) `mplus` b = ListT $
s >>= \step -> case step of
Yield h t -> return $ Yield h (t `mplus` b)
Skip t -> return $ Skip (t `mplus` b)
Empty -> return $ Skip b
 
instance MonadTrans ListT where
lift fa = ListT $ liftM (\a -> Yield a empty) fa
 
empty :: Monad f => ListT f a
empty = ListT (return Empty)
 
cons :: Monad f => a -> ListT f a -> ListT f a
cons h t = ListT . return $ Yield h t
 
data Input a = Done | Await | Element a
 
isDone :: Input a -> Bool
isDone Done = True
isDone _ = False
 
prompts :: ListT (Reader (Input a)) a
prompts = ListT . reader $ \input -> case input of
Done -> Empty
Await -> Skip prompts
Element a -> Yield a prompts
 
promptsT :: Monad f => ListT (ReaderT (Input a) f) a
promptsT = ListT . ReaderT $ \input -> case input of
Done -> return Empty
Await -> return $ Skip promptsT
Element a -> return $ Yield a promptsT
 
type IsEOF = Bool
 
data Moore a b = Feed b (Input a -> Moore a b) | Stop b IsEOF
data MooreT f a b = FeedT b (Input a -> f (MooreT f a b)) | StopT b IsEOF
 
invert :: (forall f . Monad f => ListT f a -> ListT f b)
-> Moore a (Maybe b)
invert f = go Nothing (f prompts) where
go cur res = Feed cur $ \a -> case runReader (runListT res) a of
Empty -> Stop cur (isDone a)
Yield h t -> go (Just h) t
Skip s -> go cur s
 
invertT :: Monad f => (forall t . (MonadTrans t, Monad (t f)) => ListT (t f) a -> ListT (t f) b) -> MooreT f a (Maybe b)
invertT f = go Nothing (f promptsT) where
go cur res = FeedT cur $ \a -> do
step <- runReaderT (runListT res) a
return $ case step of
Empty -> StopT cur (isDone a)
Yield h t -> go (Just h) t
Skip s -> go cur s

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.