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

后端 未结 1 989
后悔当初
后悔当初 2020-12-12 19:36

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 t

相关标签:
1条回答
  • 2020-12-12 19:52

    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
    
    0 讨论(0)
提交回复
热议问题