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.
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With