39
votes

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?

1
Using free monads with an interpreter is generally useful when you want to change how you interpret your code. For example, you might want to be able to swap out your interpretDB :: DBAction a -> IO a for interpretDebugDB :: DBAction a -> IO a that instead of connecting to your production DB, connects to your dev DB, or just returns static or random values, or logs all the actions to the console and returns static values, or whatever you want to do with it. If you're only ever going to have one interpreter, I wouldn't say you gain much other than having a DSL.bheklilr
An abstraction between your code and the database code, whether from a DSL+Free, a class for the monad, or a passed interface, allows you to use your logic independently of the DB. This is immensely useful for tests, to write logic that reasons about what will happen in the DB without actually doing it, to configure whether database calls run in a transaction independently of the code itself, or any of the examples bheklilr gave.Cirdec

1 Answers

41
votes

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