Investigate usage of PromptMonad

[idontgetoutmuch]

No description provided.

[idontgetoutmuch]

@int-e do you think it's possible to replace PromptMonad by Free? I've played around a bit and have

newtype RVarT m a = RVarT { unRVarT :: PromptT Prim m a }

newtype RVarNewT m a = RVarNewT { unRVarNewT :: FreeT Prim m a }

and

runRVarTWith :: forall m n g a. StatefulGen g m =>
                (forall t. n t -> m t) -> RVarT n a -> g -> m a
runRVarTWith liftN (RVarT m) gen = runPromptT return bindP bindN m
    where
        bindP :: forall t. (Prim t -> (t -> m a) -> m a)
        bindP prim cont = uniformPrimM prim gen >>= cont

        bindN :: forall t. n t -> (t -> m a) -> m a
        bindN nExp cont = liftN nExp >>= cont

runRVarNewTWith :: forall t m n g a . ( StatefulGen g m
                                      , MonadTrans t
                                      , Monad (t m)
                                      , Monad n
                                      , Monad (t n)) =>
                   (forall t . n t -> m t) -> RVarNewT n a -> g -> t n a
runRVarNewTWith f (RVarNewT m) gen = foldFreeT undefined undefined
  where
    -- foo :: Prim t0 -> m t0
    -- foo = \prim -> uniformPrimM prim gen

Perhaps it's just not possible to do this without thinking harder.

[idontgetoutmuch]

import Control.Monad.Free.Church
import Control.Monad.Prompt

fK :: Functor p => p r -> F p r
fK p = F (\f c -> c (fmap f p))

bToE :: Functor p => Prompt p a -> F p a
bToE p = runPromptM fK p

eToD :: F p a -> Prompt p a
eToD f = foldF prompt f

[idontgetoutmuch]

Even better I can replace fK by liftF

import Control.Monad.Free.Church
import Control.Monad.Prompt

import qualified System.IO as IO


bToE :: Functor p => Prompt p a -> F p a
bToE p = runPromptM liftF p

eToB :: F p a -> Prompt p a
eToB f = foldF prompt f

-- Example
data Terminal a
  = GetLine (String -> a)
  | PrintLine String a

instance Functor Terminal where
  fmap f (GetLine g) = GetLine (f . g)
  fmap f (PrintLine s x) = PrintLine s (f x)

myProgramE :: F Terminal ()
myProgramE = do
  a <- liftF (GetLine id)
  b <- liftF (GetLine id)
  liftF (PrintLine (a ++ b) ())

myProgramB :: Prompt Terminal ()
myProgramB = do
  a <- prompt (GetLine id)
  b <- prompt (GetLine id)
  prompt (PrintLine (a ++ b) ())

f :: Terminal a -> IO a
f (GetLine next)       = next <$> IO.getLine
f (PrintLine str next) = next <$ putStrLn str

interpretE :: F Terminal a -> IO a
interpretE = foldF f

interpretB :: Prompt Terminal a -> IO a
interpretB = runPromptM f