Using a Monadic eDSL from the REPL - haskell

Say I have created myself an embedded domain specific language in Haskell using a monad. For example a simple language that lets you push and pop values on a stack, implemented using the state monad:
type DSL a = State [Int] a
push :: Int -> DSL ()
pop :: DSL Int
Now I can write small stack manipulation programs using do notation:
program = do
push 10
push 20
a <- pop
push (5*a)
return a
However, I would really like to use my DSL interactively from a REPL (GHCi in particular, willing to use other if it would help).
Unfortunately having a session like:
>push 10
>pop
10
>push 100
Does not immediately work, which is probably rather reasonable. However I really think being able to do something with a similar feel to that would be cool. The way the state monad work does not lend itself easily to this. You need to build up your DSL a type and then evaluate it.
Is there a way to do something like this. Incrementally using a monad in the REPL?
I have been looking at things like operational, MonadPrompt, and MonadCont which I sort of get the feeling maybe could be used to do something like this. Unfortunately none of the examples I have seen addresses this particular problem.

Another possibility is to re-simulate the whole history each time you do anything. This will work for any pure monad. Here's an extemporaneous library for it:
{-# LANGUAGE RankNTypes #-}
import Data.IORef
import Data.Proxy
newtype REPL m f = REPL { run :: forall a. m a -> IO (f a) }
newREPL :: (Monad m) => Proxy m -> (forall a. m a -> f a) -> IO (REPL m f)
newREPL _ runM = do
accum <- newIORef (return ())
return $ REPL (\nextAction -> do
actions <- readIORef accum
writeIORef accum (actions >> nextAction >> return ())
return (runM (actions >> nextAction)))
Basically, it stores all the actions run thus far in an IORef, and each time you do something it adds to the list of actions and runs it from the top.
To create a repl, use newREPL, passing it a Proxy for the monad and a "run" function that gets you out of the monad. The reason the run function has type m a -> f a instead of m a -> a is so that you can include extra information in the output -- for example, you might want to view the current state, too, in which case you could use an f like:
data StateOutput a = StateOutput a [Int]
deriving (Show)
But I have just used it with Identity which does nothing special.
The Proxy argument is so that ghci's defaulting doesn't bite us when we create a new repl instance.
Here's how you use it:
>>> repl <- newREPL (Proxy :: Proxy DSL) (\m -> Identity (evalState m []))
>>> run repl $ push 1
Identity ()
>>> run repl $ push 2
Identity ()
>>> run repl $ pop
Identity 2
>>> run repl $ pop
Identity 1
If the extra Identity line noise bothers you, you could use your own functor:
newtype LineOutput a = LineOutput a
instance (Show a) => Show (LineOutput a) where
show (LineOutput x) = show x
There was one small change I had to make -- I had to change
type DSL a = State [Int] a
to
type DSL = State [Int]
because you can't use type synonyms that are not fully applied, like when I said Proxy :: DSL. The latter, I think, is more idiomatic anyway.

To an extent.
I don't believe it can be done for arbitrary Monads/instruction sets, but here's something that would work for your example. I'm using operational with an IORef to back the REPL state.
data DSLInstruction a where
Push :: Int -> DSLInstruction ()
Pop :: DSLInstruction Int
type DSL a = Program DSLInstruction a
push :: Int -> DSL ()
push n = singleton (Push n)
pop :: DSL Int
pop = singleton Pop
-- runDslState :: DSL a -> State [Int] a
-- runDslState = ...
runDslIO :: IORef [Int] -> DSL a -> IO a
runDslIO ref m = case view m of
Return a -> return a
Push n :>>= k -> do
modifyIORef ref (n :)
runDslIO ref (k ())
Pop :>>= k -> do
n <- atomicModifyIORef ref (\(n : ns) -> (ns, n))
runDslIO ref (k n)
replSession :: [Int] -> IO (Int -> IO (), IO Int)
replSession initial = do
ref <- newIORef initial
let pushIO n = runDslIO ref (push n)
popIO = runDslIO ref pop
(pushIO, popIO)
Then you can use it like:
> (push, pop) <- replSession [] -- this shadows the DSL push/pop definitions
> push 10
> pop
10
> push 100
It should be straightforward to use this technique for State/Reader/Writer/IO-based DSLs. I don't expect it to work for everything though.

Related

How to hide state from functions that call other functions that use that state

I would like to have some higher level functions in my Haskell program call other functions that eventually call functions that use some state or configuration, and not have to pass the state around all these function calls. I understand this is a classic use of the state monad (or possibly the Reader monad?).
(I'm also not sure if it should be StateT (as in my example below) to enable doing IO, or if results should somehow be output separately.)
At this stage I'm pretty confused by all the tutorials, blog posts, and similar questions here, and can't pick out the solution. Or have I misunderstood the hiding thing?
Here's a small example:
import Control.Monad.State
-- Here's a simple configuration type:
data Config = MkConfig {
name :: String
, num :: Int
} deriving Show
-- Here's a couple of configurations.
-- (They're hard coded and pre-defined.)
c1 = MkConfig "low" 7
c2 = MkConfig "high" 10
-- Here's a lower level function that explicitly uses the config.
-- (The String is ignored here for simplicity, but it could be used.)
fun :: Config -> Int -> Int
fun (MkConfig _ i) j = i*j
-- testA and GoA work fine as expected.
-- fun uses the different configs c1,c2 in the right way.
testA = do
a <- get
lift (print (fun a 2))
put c2
a <- get
lift (print (fun a 4))
goA = evalStateT testA c1
-- (c1 could be put at the start of testA instead.)
-- But what I really want is to use fun2 that calls fun,
-- and not explicitly need state.
-- But this function definition does not compile:
fun2 :: Int -> Int
fun2 j = 3 * fun cf j
-- fun needs a config arg cf, but where from?
-- I would like a similar way of using fun2 as in testB and goB here.
testB = do
a <- get
lift (print (fun2 3)) -- but fun2 doesn't take the state in a
put c2
a <- get
lift (print (fun2 42)) -- but fun2 doesn't take the state in a
goB = evalStateT testB c1
I want to hide the configuration away from the higher level functions like fun2 in my program, while still retaining the ability to change configuration and run those functions with the new configuration. This is a 'how to do it question' (unless I've got the wrong idea completely).
You can't quite "hide the configuration away" in the type signature, of course: a plain old function Int -> Int must be referentially transparent, and so it can't also depend on or accept some Config value.
What you probably want to do is something like:
fun2 :: Int -> State Config Int -- An `Int -> Int` that depends on `Config` state.
-- Compare to how `Int -> IO Int` is like an
-- `Int -> Int` function that depends on IO.
fun2 j = do
c1 <- get
return (3 * fun c1 j)
And then wherever you have a c :: Config, you can get the result by something like
let result = evalState (fun2 42) c -- An Int.
See also Combining StateT IO with State:
hoistState :: Monad m => State s a -> StateT s m a
hoistState = StateT . (return .) . runState
Then you can write something like
testB :: StateT Config IO ()
testB = do
-- Fancy:
result <- hoistState (fun2 42)
-- Equivalent:
c <- get
let result' = evalState (fun2 42) c
lift (print (result, result'))

Is there a standard abstraction for this request-response type?

I have the following type:
data S req rsp = Done rsp | Next req (rsp -> S req rsp)
The idea is to use it as a pure representation for network communication, i.e:
... Next GetUser $ \uid -> Next (Login uid) $ \success -> Done success
Which would then be evaluated by some impure function eval.
Now, what is this (if anything?) It's not a monad, neither an arrow, as far as I can see. It seems to be something between a stream/pipe/automaton/fsm and the continuation monad. This makes me think that there might be a better representation for this type of thing, but what?
It's Free Monad.
The idea is that you have a description of instructions for which you can have multiple interpreters like your eval function. Free Monad abstracts over the pattern that this task has. For details I recommend this great post.
To adapt your type to Free we can do the following:
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Free
data Instruction req rsp next =
Respond rsp |
Interact req (rsp -> next)
deriving (Functor)
type S req rsp =
Free (Instruction req rsp)
respond :: rsp -> S req rsp ()
respond rsp =
liftF (Respond rsp)
interact :: req -> S req rsp rsp
interact req =
liftF (Interact req id)
Now, thanks to Free, S req rsp is a monad, which means that you can now compose your respond and interact functions using Monad API.
There's more to it. The respond and interact functions could be generated using Template Haskell with the following extra code:
{-# LANGUAGE TemplateHaskell #-}
import Control.Monad.Free.TH
makeFree ''Instruction
Your type looks a little bit like Apfelmus's operational monad, also known as the Freer monad:
data Program inst a where
Return :: a -> Program inst a
Bind :: inst a -> (a -> Program inst b) -> Program inst b
instance Monad (Program inst) where
return = Return
Return x >>= f = f x
Bind i next >>= f = Bind i (fmap (>>= f) next)
-- plus the usual Functor and Applicative boilerplate
Program :: (* -> *) -> * -> * represents a sequence of instructions inst, which use their type parameter to indicate the "return type" of running that instruction in an interpreter. The Bind constructor takes an instruction and a continuation which can be run after the result of the instruction has been received from the interpreter. Note how a is existentially quantified, reflecting the fact that the types of all the intermediate steps in a computation are not relevant to the overall type.
The important difference between Program and your type is that the type of the response is determined by the instruction, rather than being fixed over the whole computation. This allows us to make more fine-grained guarantees about the response that each request expects to provoke.
For example, here's the state monad written as a Program:
data StateI s r where
Get :: StateI s s
Put :: s -> StateI s ()
type State s = Program (StateI s)
get :: State s s
get = Bind Get Return
put :: s -> State s ()
put s = Bind (Put s) Return
modify :: (s -> s) -> State s ()
modify f = do
x <- get
put (f x)
runState :: State s a -> s -> (s, a)
runState (Return x) s = (s, x)
runState (Bind Get next) s = runState (next s) s
runState (Bind (Put s) next) _ = runState (next ()) s
The co-Yoneda lemma tells us that Program is isomorphic to Free. Intuitively, it's a free monad based on ->'s Functor instance. For certain operations like left-associative binds, Program can be more efficient than Free, because its >>= is based on function composition, rather than possibly-expensively fmapping an arbitrary Functor.

Abstraction for monadic recursion with "unless"

I'm trying to work out if it's possible to write an abstraction for the following situation. Suppose I have a type a with function a -> m Bool e.g. MVar Bool and readMVar. To abstract this concept out I create a newtype wrapper for the type and its function:
newtype MPredicate m a = MPredicate (a,a -> m Bool)
I can define a fairly simple operation like so:
doUnless :: (Monad m) => Predicate m a -> m () -> m ()
doUnless (MPredicate (a,mg)) g = mg a >>= \b -> unless b g
main = do
b <- newMVar False
let mpred = MPredicate (b,readMVar)
doUnless mpred (print "foo")
In this case doUnless would print "foo". Aside: I'm not sure whether a type class might be more appropriate to use instead of a newtype.
Now take the code below, which outputs an incrementing number then waits a second and repeats. It does this until it receives a "turn off" instruction via the MVar.
foobar :: MVar Bool -> IO ()
foobar mvb = foobar' 0
where
foobar' :: Int -> IO ()
foobar' x = readMVar mvb >>= \b -> unless b $ do
let x' = x + 1
print x'
threadDelay 1000000
foobar' x'
goTillEnter :: MVar Bool -> IO ()
goTillEnter mv = do
_ <- getLine
_ <- takeMVar mv
putMVar mv True
main = do
mvb <- newMVar False
forkIO $ foobar mvb
goTillEnter mvb
Is it possible to refactor foobar so that it uses MPredicate and doUnless?
Ignoring the actual implementation of foobar' I can think of a simplistic way of doing something similar:
cycleUnless :: x -> (x -> x) -> MPredicate m a -> m ()
cycleUnless x g mp = let g' x' = doUnless mp (g' $ g x')
in g' $ g x
Aside: I feel like fix could be used to make the above neater, though I still have trouble working out how to use it
But cycleUnless won't work on foobar because the type of foobar' is actually Int -> IO () (from the use of print x').
I'd also like to take this abstraction further, so that it can work threading around a Monad. With stateful Monads it becomes even harder. E.g.
-- EDIT: Updated the below to show an example of how the code is used
{- ^^ some parent function which has the MVar ^^ -}
cycleST :: (forall s. ST s (STArray s Int Int)) -> IO ()
cycleST sta = readMVar mvb >>= \b -> unless b $ do
n <- readMVar someMVar
i <- readMVar someOtherMVar
let sta' = do
arr <- sta
x <- readArray arr n
writeArray arr n (x + i)
return arr
y = runSTArray sta'
print y
cycleST sta'
I have something similar to the above working with RankNTypes. Now there's the additional problem of trying to thread through the existential s, which is not likely to type check if threaded around through an abstraction the likes of cycleUnless.
Additionally, this is simplified to make the question easier to answer. I also use a set of semaphores built from MVar [MVar ()] similar to the skip channel example in the MVar module. If I can solve the above problem I plan to generalize the semaphores as well.
Ultimately this isn't some blocking problem. I have 3 components of the application operating in a cycle off the same MVar Bool but doing fairly different asynchronous tasks. In each one I have written a custom function that performs the appropriate cycle.
I'm trying to learn the "don't write large programs" approach. What I'd like to do is refactor chunks of code into their own mini libraries so that I'm not building a large program but assembling lots of small ones. But so far this particular abstraction is escaping me.
Any thoughts on how I might go about this are very much appreciated!
You want to cleanly combine a stateful action having side effects, a delay, and an independent stopping condition.
The iterative monad transformer from the free package can be useful in these cases.
This monad transformer lets you describe a (possibly nonending) computation as a series of discrete steps. And what's better, it let's you interleave "stepped" computations using mplus. The combined computation stops when any of the individual computations stops.
Some preliminary imports:
import Data.Bool
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Iter (delay,untilJust,IterT,retract,cutoff)
import Control.Concurrent
Your foobar function could be understood as a "sum" of three things:
A computation that does nothing but reading from the MVar at each step, and finishes when the Mvar is True.
untilTrue :: (MonadIO m) => MVar Bool -> IterT m ()
untilTrue = untilJust . liftM guard . liftIO . readMVar
An infinite computation that takes a delay at each step.
delays :: (MonadIO m) => Int -> IterT m a
delays = forever . delay . liftIO . threadDelay
An infinite computation that prints an increasing series of numbers.
foobar' :: (MonadIO m) => Int -> IterT m a
foobar' x = do
let x' = x + 1
liftIO (print x')
delay (foobar' x')
With this in place, we can write foobar as:
foobar :: (MonadIO m) => MVar Bool -> m ()
foobar v = retract (delays 1000000 `mplus` untilTrue v `mplus` foobar' 0)
The neat thing about this is that you can change or remove the "stopping condition" and the delay very easily.
Some clarifications:
The delay function is not a delay in IO, it just tells the iterative monad transformer to "put the argument in a separate step".
retract brings you back from the iterative monad transformer to the base monad. It's like saying "I don't care about the steps, just run the computation". You can combine retract with cutoff if you want to limit the maximum number of iterations.
untilJustconverts a value m (Maybe a) of the base monad into a IterT m a by retrying in each step until a Just is returned. Of course, this risks non-termination!
MPredicate is rather superfluous here; m Bool can be used instead. The monad-loops package contains plenty of control structures with m Bool conditions. whileM_ in particular is applicable here, although we need to include a State monad for the Int that we're threading around:
import Control.Monad.State
import Control.Monad.Loops
import Control.Applicative
foobar :: MVar Bool -> IO ()
foobar mvb = (`evalStateT` (0 :: Int)) $
whileM_ (not <$> lift (readMVar mvb)) $ do
modify (+1)
lift . print =<< get
lift $ threadDelay 1000000
Alternatively, we can use a monadic version of unless. For some reason monad-loops doesn't export such a function, so let's write it:
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM mb action = do
b <- mb
unless b action
It's somewhat more convenient and more modular in a monadic setting, since we can always go from a pure Bool to m Bool, but not vice versa.
foobar :: MVar Bool -> IO ()
foobar mvb = go 0
where
go :: Int -> IO ()
go x = unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
go x'
You mentioned fix; sometimes people indeed use it for ad-hoc monadic loops, for example:
printUntil0 :: IO ()
printUntil0 =
putStrLn "hello"
fix $ \loop -> do
n <- fmap read getLine :: IO Int
print n
when (n /= 0) loop
putStrLn "bye"
With some juggling it's possible to use fix with multi-argument functions. In the case of foobar:
foobar :: MVar Bool -> IO ()
foobar mvb = ($(0 :: Int)) $ fix $ \loop x -> do
unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
loop x'
I'm not sure what's your MPredicate is doing.
First, instead of newtyping a tuple, it's probably better to use a normal algebric data type
data MPredicate a m = MPredicate a (a -> m Bool)
Second, the way you use it, MPredicate is equivalent to m Bool.
Haskell is lazzy, therefore there is no need to pass, a function and it's argument (even though
it's usefull with strict languages). Just pass the result, and the function will be called when needed.
I mean, instead of passing (x, f) around, just pass f x
Of course, if you are not trying to delay the evaluation and really need at some point, the argument or the function as well as the result, a tuple is fine.
Anyway, in the case your MPredicate is only there to delay the function evaluation, MPredicat reduces to m Bool and doUnless to unless.
Your first example is strictly equivalent :
main = do
b <- newMVar False
unless (readMVar b) (print "foo")
Now, if you want to loop a monad until a condition is reach (or equivalent) you should have a look at the monad-loop package. What you are looking it at is probably untilM_ or equivalent.

What are good Haskell conventions for managing deeply nested bracket patterns?

I am currently working with Haskell bindings to a HDF5 C library. Like many C libraries, this one uses many pointers in its functions calls.
The usual "best practice" Haskell functions for allocating and releasing C resources follow the bracket pattern, like alloca, withArray, etc. In using them, I often enter several nested brackets. For instance, here is a small excerpt for HDF5 bindings:
selectHyperslab rID dName = withDataset rID dName $ \dID -> do
v <- withDataspace 10 $ \dstDS -> do
srcDS <- c'H5Dget_space dID
dat <- alloca3 (0, 1, 10) $ \(start, stride, count) -> do
err <- c'H5Sselect_hyperslab srcDS c'H5S_SELECT_SET start stride count nullPtr
-- do some work ...
return value
alloca3 (a, b, c) action =
alloca $ \aP -> do
poke aP a
alloca $ \bP -> do
poke bP b
alloca $ \cP -> do
poke cP c
action (aP, bP, cP)
In the code above, the nested brackets are bracket functions I wrote withDataset, withDataspace, and alloca3, which I wrote to prevent the bracket nesting from going another 3 levels deep in the code. For C libraries with lots of resource acquisition calls and pointer arguments, coding with the standard bracket primitives can get unmanageable (which is why I wrote alloca3 to reduce the nesting.)
So generally, are there any best practices or coding techniques to help reduce the nesting of brackets when needing to allocate and deallocate many resources (such as with C calls)? The only alternative I have found is the ResourceT transformer, which from the tutorial looks like it is designed to make interleaving resource acquire/release possible, and not to simplify the bracket pattern.
Recently I was investigating this problem in Scala. The recurring pattern is (a -> IO r) -> IO r, where a given function is executed within some resource allocation context given a value of type a. And this is just ContT r IO a, which is readily available in Haskell. So we can write:
import Control.Monad
import Control.Monad.Cont
import Control.Monad.IO.Class
import Control.Exception (bracket)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable)
import Foreign.Marshal.Alloc (alloca)
allocaC :: Storable a => ContT r IO (Ptr a)
allocaC = ContT alloca
bracketC :: IO a -> (a -> IO b) -> ContT r IO a
bracketC start end = ContT (bracket start end)
bracketC_ :: IO a -> IO b -> ContT r IO a
bracketC_ start end = ContT (bracket start (const end))
-- ...etc...
-- | Example:
main :: IO ()
main = flip runContT return $ do
bracketC_ (putStrLn "begin1") (putStrLn "end1")
bracketC_ (putStrLn "begin2") (putStrLn "end2")
liftIO $ putStrLn "..."
The standard monad/applicative functions allow you to simplify a lot of your code, for example:
allocAndPoke :: (Storable a) => a -> ContT r IO (Ptr a)
allocAndPoke x = allocaC >>= \ptr -> liftIO (poke ptr x) >> return ptr
-- With the monad alloca3 won't be probably needed, just as an example:
alloca3C (a, b, c) =
(,,) <$> allocAndPoke a <*> allocAndPoke b <*> allocAndPoke c
allocaManyC :: (Storable a) => [a] -> ContT r IO [Ptr a]
allocaManyC = mapM allocAndPoke

When would I want to use a Free Monad + Interpreter pattern?

I'm working on a project that, amongst other things, involves a database access layer. Pretty normal, really. In a previous project, a collaborator encouraged me to use the Free Monads concept for a database layer and so I did. Now I'm trying to decide in my new project what I gain.
In the previous project, I had an API that looked rather like this.
saveDocument :: RawDocument -> DBAction ()
getDocuments :: DocumentFilter -> DBAction [RawDocument]
getDocumentStats :: DBAction [(DocId, DocumentStats)]
etc. About twenty such public functions. To support them, I had the DBAction data structure:
data DBAction a =
SaveDocument RawDocument (DBAction a)
| GetDocuments DocumentFilter ([RawDocument] -> DBAction a)
| GetDocumentStats ([(DocId, DocumentStats)] -> DBAction a)
| Return a
And then a monad implementation:
instance Monad DBAction where
return = Return
SaveDocument doc k >>= f = SaveDocument doc (k >>= f)
GetDocuments df k >>= f = GetDocuments df (k >=> f)
And then the interpreter. And then the primitive functions that implement each of the different queries. Basically, I'm feeling that I had a huge amount of glue code.
In my current project (in a totally different field), I have instead gone with a pretty ordinary monad for my database:
newtype DBM err a = DBM (ReaderT DB (EitherT err IO) a)
deriving (Monad, MonadIO, MonadReader DB)
indexImage :: (ImageId, UTCTime) -> Exif -> Thumbnail -> DBM SaveError ()
removeImage :: DB -> ImageId -> DBM DeleteError ()
And so on. I figure that, ultimately, I'll have the "public" functions that represent high level concepts all running in the DBM context, and then I'll have the whole slew of functions that do the SQL/Haskell glue. This is, overall, feeling much better than the free monad system because I'm not writing a huge amount of boilerplate code to gains me nothing but the ability to swap out my interpreter.
Or...
Do I actually gain something else with the Free Monad + Interpreter pattern? If so, what?
As mentioned in the comments, it is frequently desirable to have some abstraction between code and database implementation. You can get much of the same abstraction as a free monad by defining a class for your DB Monad (I've taken a couple liberties here):
class (Monad m) => MonadImageDB m where
indexImage :: (ImageId, UTCTime) -> Exif -> Thumbnail -> m SaveResult
removeImage :: ImageId -> m DeleteResult
If your code is written against MonadImageDB m => instead of tightly coupled to DBM, you will be able to swap out the database and error handling without modifying your code.
Why would you use free instead? Because it "frees the interpreter as much as possible", meaning the intepreter is only committed to providing a monad, and nothing else. This means you are as unconstrained as possible writing monad instances to go with your code. Note that, for the free monad, you don't write your own instance for Monad, you get it for free. You'd write something like
data DBActionF next =
SaveDocument RawDocument ( next)
| GetDocuments DocumentFilter ([RawDocument] -> next)
| GetDocumentStats ([(DocId, DocumentStats)] -> next)
derive Functor DBActionF, and get the monad instance for Free DBActionF from the existing instance for Functor f => Monad (Free f).
For your example, it'd instead be:
data ImageActionF next =
IndexImage (ImageId, UTCTime) Exif Thumbnail (SaveResult -> next)
| RemoveImage ImageId (DeleteResult -> next)
You can also get the property "frees the interpreter as much as possible" for the type class. If you have no other constraints on m than the type class, MonadImageDB, and all of MonadImageDB's methods could be constructors for a Functor, then you get the same property. You can see this by implementing instance MonadImageDB (Free ImageActionF).
If you are going to mix your code with interactions with some other monad, you can get a monad transformer from free instead of a monad.
Choosing
You don't have to choose. You can convert back and forth between the representations. This example shows how to do so for actions with zero, one, or two arguments returning zero, one, or two results. First, a bit of boilerplate
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Monad.Free
We have a type class
class Monad m => MonadAddDel m where
add :: String -> m Int
del :: Int -> m ()
set :: Int -> String -> m ()
add2 :: String -> String -> m (Int, Int)
nop :: m ()
and an equivalent functor representation
data AddDelF next
= Add String ( Int -> next)
| Del Int ( next)
| Set Int String ( next)
| Add2 String String (Int -> Int -> next)
| Nop ( next)
deriving (Functor)
Converting from the free representation to the type class replaces Pure with return, Free with >>=, Add with add, etc.
run :: MonadAddDel m => Free AddDelF a -> m a
run (Pure a) = return a
run (Free (Add x next)) = add x >>= run . next
run (Free (Del id next)) = del id >> run next
run (Free (Set id x next)) = set id x >> run next
run (Free (Add2 x y next)) = add2 x y >>= \ids -> run (next (fst ids) (snd ids))
run (Free (Nop next)) = nop >> run next
A MonadAddDel instance for the representation builds functions for the next arguments of the constructors using Pure.
instance MonadAddDel (Free AddDelF) where
add x = Free . (Add x ) $ Pure
del id = Free . (Del id ) $ Pure ()
set id x = Free . (Set id x) $ Pure ()
add2 x y = Free . (Add2 x y) $ \id1 id2 -> Pure (id1, id2)
nop = Free . Nop $ Pure ()
(Both of these have patterns we could extract for production code, the hard part to writing these generically would be dealing with the varying number of input and result arguments)
Coding against the type class uses only the MonadAddDel m => constraint, for example:
example1 :: MonadAddDel m => m ()
example1 = do
id <- add "Hi"
del id
nop
(id3, id4) <- add2 "Hello" "World"
set id4 "Again"
I was too lazy to write another instance for MonadAddDel besides the one I got from free, and too lazy to make an example besides by using the MonadAddDel type class.
If you like running example code, here's enough to see the example interpreted once (converting the type class representation to the free representation), and again after converting the free representation back to the type class representation again. Again, I'm too lazy to write the code twice.
debugInterpreter :: Free AddDelF a -> IO a
debugInterpreter = go 0
where
go n (Pure a) = return a
go n (Free (Add x next)) =
do
print $ "Adding " ++ x ++ " with id " ++ show n
go (n+1) (next n)
go n (Free (Del id next)) =
do
print $ "Deleting " ++ show id
go n next
go n (Free (Set id x next)) =
do
print $ "Setting " ++ show id ++ " to " ++ show x
go n next
go n (Free (Add2 x y next)) =
do
print $ "Adding " ++ x ++ " with id " ++ show n ++ " and " ++ y ++ " with id " ++ show (n+1)
go (n+2) (next n (n+1))
go n (Free (Nop next)) =
do
print "Nop"
go n next
main =
do
debugInterpreter example1
debugInterpreter . run $ example1

Resources