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