我什么时候想要使用免费的Monad + Interpreter模式？
我正在开发一个项目，其中包括一个数据库访问层。 很正常，真的。 在之前的一个项目中，合作者鼓励我将Free Monad概念用于数据库层，所以我这样做了。 现在我试图在我的新项目中决定我所获得的。
在之前的项目中，我有一个相当像这样的API。
saveDocument :: RawDocument -> DBAction () getDocuments :: DocumentFilter -> DBAction [RawDocument] getDocumentStats :: DBAction [(DocId, DocumentStats)] 等约二十个这样的公共职能。 为了支持他们，我有了DBAction数据结构：
data DBAction a = SaveDocument RawDocument (DBAction a) | GetDocuments DocumentFilter ([RawDocument] -> DBAction a) | GetDocumentStats ([(DocId, DocumentStats)] -> DBAction a) | Return a
然后是monad实现：
instance Monad DBAction where return = Return SaveDocument doc k >>= f = SaveDocument doc (k >>= f) GetDocuments df k >>= f = GetDocuments df (k >=> f)
然后是翻译。 然后是实现每个不同查询的原始函数。 基本上，我觉得我有大量的胶水代码。
在我目前的项目中（完全不同的领域），我已经为我的数据库用了一个非常普通的monad：
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 ()
等等。 我想，最终，我将拥有代表在DBM上下文中运行的高级概念的“公共”function，然后我将拥有完成SQL / Haskell粘合的function。 总的来说，感觉比自由monad系统要好得多，因为我没有写出大量的样板代码，只能replace掉我的解释器。
要么…
我是否真的用Free Monad + Interpreter模式获得了其他的东西？ 如果是这样，什么？
正如在评论中提到的那样，在代码和数据库实现之间经常需要抽象。 你可以通过为你的DB Monad定义一个类来获得与自由单体相同的抽象（我在这里已经采取了一些自由）：
class (Monad m) => MonadImageDB m where indexImage :: (ImageId, UTCTime) -> Exif -> Thumbnail -> m SaveResult removeImage :: ImageId -> m DeleteResult
如果您的代码是针对MonadImageDB m =>编写的，而不是紧密耦合到DBM ，则可以在不修改代码的情况下交换数据库和error handling。
你为什么要用免费的？ 因为它“尽可能释放解释者” ，这意味着解释者只是致力于提供一个monad，而不是别的。 这意味着你尽可能没有约束地写monad实例来处理你的代码。 请注意，对于免费的monad，您不需要为Monad编写自己的实例， 而是免费获得它 。 你会写一些像
data DBActionF next = SaveDocument RawDocument ( next) | GetDocuments DocumentFilter ([RawDocument] -> next) | GetDocumentStats ([(DocId, DocumentStats)] -> next)
派生Functor DBActionF ，并从Functor f => Monad (Free f)的现有实例中获取Free DBActionF的monad实例。
对于你的例子，它将会是：
data ImageActionF next = IndexImage (ImageId, UTCTime) Exif Thumbnail (SaveResult -> next) | RemoveImage ImageId (DeleteResult -> next)
您也可以获得该types的“尽可能释放解释器”的属性。 如果你对m的types没有其他限制， MonadImageDB和MonadImageDB的所有方法都可以是一个Functor构造Functor ，那么你可以得到相同的属性。 你可以通过实现instance MonadImageDB (Free ImageActionF)来看到这一点。
如果您要将代码与其他monad的交互混用，您可以免费获得monad变压器，而不是monad。
select
你不必select。 您可以在表示之间来回转换。 这个例子展示了如何为零，一个或两个返回零，一个或两个结果的操作执行操作。 首先是一些样板
{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} import Control.Monad.Free
我们有一个types的类
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 ()
和一个等效的仿函数expression式
data AddDelF next = Add String ( Int -> next) | Del Int ( next) | Set Int String ( next) | Add2 String String (Int -> Int -> next) | Nop ( next) deriving (Functor)
从自由表示到types类的转换用PurereplacePure ，用>>= ， Free和Add等add 。
run :: MonadAddDel m => Free AddDelF a -> ma 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 xy next)) = add2 xy >>= \ids -> run (next (fst ids) (snd ids)) run (Free (Nop next)) = nop >> run next
该表示的MonadAddDel实例为使用Pure构造函数的next参数构build函数。
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 xy = Free . (Add2 xy) $ \id1 id2 -> Pure (id1, id2) nop = Free . Nop $ Pure ()
（这两种模式都有我们可以提取的用于生产代码的模式，这些一般编写的难点在于处理不同数量的input和结果参数）
对types类进行编码只使用MonadAddDel m =>约束，例如：
example1 :: MonadAddDel m => m () example1 = do id <- add "Hi" del id nop (id3, id4) <- add2 "Hello" "World" set id4 "Again"
我懒得写一个MonadAddDel实例，除了我从free得到的，也懒得做一个例子，除了使用MonadAddDel类的类。
如果你喜欢运行示例代码，这里就足以看到一次解释的例子（将types表示转换为自由表示），再次将自由表示再次转换为types表示。 再次，我懒得写代码两次。
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 xy 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
