Question

我最近一直在教自己free包中的Free monad，但我遇到了问题。我想为不同的库提供不同的免费monad，基本上我想为不同的上下文构建DSL，但我也希望能够将它们组合在一起。举个例子：

{-# LANGUAGE DeriveFunctor #-}
module TestingFree where

import Control.Monad.Free

data BellsF x
    = Ring x
    | Chime x
    deriving (Functor, Show)

type Bells = Free BellsF

data WhistlesF x
    = PeaWhistle x
    | SteamWhistle x
    deriving (Functor, Show)

type Whistles = Free WhistlesF

ring :: Bells ()
ring = liftF $ Ring ()

chime :: Bells ()
chime = liftF $ Chime ()

peaWhistle :: Whistles ()
peaWhistle = liftF $ PeaWhistle ()

steamWhistle :: Whistles ()
steamWhistle = liftF $ SteamWhistle ()


playBells :: Bells r -> IO r
playBells (Pure r)         = return r
playBells (Free (Ring x))  = putStrLn "RingRing!" >> playBells x
playBells (Free (Chime x)) = putStr "Ding-dong!" >> playBells x

playWhistles :: Whistles () -> IO ()
playWhistles (Pure _)                = return ()
playWhistles (Free (PeaWhistle x))   = putStrLn "Preeeet!" >> playWhistles x
playWhistles (Free (SteamWhistle x)) = putStrLn "Choo-choo!" >> playWhistles x

现在，我希望能够创建一个BellsAndWhistles类型，这样我就可以毫不费力地合并Bells和Whistles的功能。

由于问题是组合monad，我的第一个想法是查看Control.Monad.Trans.Free模块以获得快速简便的解决方案。不幸的是，有一些稀疏的例子，没有一个显示我想做什么。此外，似乎堆叠两个或更多免费monad不起作用，因为MonadFree具有m -> f的功能依赖性。从本质上讲，我希望能够编写如下代码：

newtype BellsAndWhistles m a = BellsAndWhistles
    { unBellsAndWhistles :: ???
    } deriving
        ( Functor
        , Monad
        -- Whatever else needed
        )

noisy :: Monad m => BellsAndWhistles m ()
noisy = do
    lift ring
    lift peaWhistle
    lift chime
    lift steamWhistle

play :: BellsAndWhistles IO () -> IO ()
play bellsNwhistles = undefined

但是以这样的方式Bells和Whistles可以存在于单独的模块中，而不必了解彼此的实现。我的想法是，我可以为不同的任务编写独立模块，每个模块都实现自己的DSL，然后根据需要将它们组合成“更大”的DSL。有一个简单的方法吗？

作为奖励，能够利用已经编写的不同play*函数是非常好的，这样我就可以将它们交换出来。我希望能够使用一个免费的解释器进行调试，另一个用于生产，显然可以选择单独调试哪个DSL。

Answer 1

这是基于论文Data types à la carte的答案，除了没有类型类。我建议阅读那篇论文。

诀窍在于，不是为Bells和Whistles编写解释器，而是为他们的单个仿函数步骤BellsF和WhistlesF定义解释器，如下所示：

playBellsF :: BellsF (IO a) -> IO a
playBellsF (Ring  io) = putStrLn "RingRing!"  >> io
playBellsF (Chime io) = putStr   "Ding-dong!" >> io

playWhistlesF :: WhistelsF (IO a) -> IO a
playWhistlesF (PeaWhistle   io) = putStrLn "Preeeet!"   >> io
playWhistlesF (SteamWhistle io) = putStrLn "choo-choo!" >> io

如果您选择不将它们合并，则只需将它们传递给Control.Monad.Free.iterM即可恢复原始播放功能：

playBells    :: Bells a    -> IO a
playBells    = iterM playBell

playWhistles :: Whistles a -> IO a
playWhistles = iterM playWhistlesF

...但是因为他们处理单个步骤，所以可以更容易地组合它们。您可以像这样定义一个新的组合免费monad：

data BellsAndWhistlesF a = L (BellsF a) | R (WhistlesF a)

然后把它变成一个免费的monad：

type BellsAndWhistles = Free BellsAndWhistlesF

然后根据两个子解释器为BellsAndWhistlesF的单个步骤编写一个解释器：

playBellsAndWhistlesF :: BellsAndWhistlesF (IO a) -> IO a
playBellsAndWhistlesF (L bs) = playBellsF    bs
playBellsAndWhistlesF (R ws) = playWhistlesF ws

...然后你通过将其传递给iterM来获得免费monad的翻译：

playBellsAndWhistles :: BellsAndWhistles a -> IO a
playBellsAndWhistles = iterM playBellsAndWhistlesF

因此，您的问题的答案是，组合免费monad的技巧是通过为各个函子步骤（“代数”）定义中间解释器来保留更多信息。对于免费monad来说，这些“代数”比解释器更容易组合。

Answer 2

加布里埃尔的回答很明显，但我认为有必要更多地强调一切使得它全部有效，这就是两个Functor的总和也是{{1} } ：

Functor

（Edward Kmett的图书馆将其作为Data.Functor.Coproduct。）

因此，如果-- | Data type to encode the sum of two 'Functor's @f@ and @g@. data Sum f g a = InL (f a) | InR (g a) -- | The 'Sum' of two 'Functor's is also a 'Functor'. instance (Functor f, Functor g) => Functor (Sum f g) where fmap f (InL fa) = InL (fmap f fa) fmap f (InR ga) = InR (fmap f ga) -- | Elimination rule for the 'Sum' type. elimSum :: (f a -> r) -> (g a -> r) -> Sum f g a -> r elimSum f _ (InL fa) = f fa elimSum _ g (InR ga) = g ga是Functor monad的“指令集”，那么：

Sum functors为您提供此类指令集的联合，从而为相应的组合免费monad

Free功能是一项基本规则，允许您从elimSum的解释器和Sum f g的解释器中构建f解释器。

"Data types à la carte"技术正是您在开发这种洞察力时所获得的技术 - 手工制作它是非常值得的。

这种g代数是值得学习的东西。例如：

Functor

Gershom Bazerman的博客文章"Abstracting with Applicatives"扩展了关于data Product f g a = Product (f a) (g a) -- | The 'Product' of two 'Functor's is also a 'Functor'. instance (Functor f, Functor g) => Functor (Product f g) where fmap f (Product fa ga) = Product (fmap f fa) (fmap f ga) -- | The 'Product' of two 'Applicative's is also an 'Applicative'. instance (Applicative f, Applicative g) => Applicative (Product f g) where pure x = Product (pure x) (pure x) Product ff gf <*> Product fa ga = Product (ff <*> fa) (gf <*> ga) -- | 'Compose' is to 'Applicative' what monad transformers are to 'Monad'. -- If your problem domain doesn't need the full power of the 'Monad' class, -- then applicative composition might be a good alternative on how to combine -- effects. data Compose f g a = Compose (f (g a)) -- | The composition of two 'Functor's is also a 'Functor'. instance (Functor f, Functor g) => Functor (Compose f g) where fmap f (Compose fga) = Compose (fmap (fmap f) fga) -- | The composition of two 'Applicative's is also an 'Applicative'. instance (Applicative f, Applicative g) => Applicative (Compose f g) where pure = Compose . pure . pure Compose fgf <*> Compose fga = Compose ((<*>) <$> fgf <*> fga)的这些观点，非常值得一读。

编辑：我要注意的最后一点是，当人们为他们的免费monad设计他们的自定义Applicative时，实际上，隐含地他们正在使用这些技术。我将从Gabriel的"Why free monads matter"中得到两个例子：

Functor

所有这些都可以分析为data Toy b next = Output b next | Bell next | Done data Interaction next = Look Direction (Image -> next) | Fire Direction next | ReadLine (String -> next) | WriteLine String (Bool -> next)，Product，Sum，Compose仿函数和以下三种组合的某种组合：

(->)

因此，为了简洁，使用以下类型的同义词：

-- | Provided by "Control.Applicative" newtype Const b a = Const b instance Functor (Const b) where fmap _ (Const b) = Const b -- | Provided by "Data.Functor.Identity" newtype Identity a = Identity a instance Functor Identity where fmap f (Identity a) = Identity (f a) -- | Near-isomorphic to @Const ()@ data VoidF a = VoidF instance Functor VoidF where fmap _ VoidF = VoidF

...我们可以像这样重写那些仿函数：

{-# LANGUAGE TypeOperators #-} type f :+: g = Sum f g type f :*: g = Product f g type f :.: g = Compose f g infixr 6 :+: infixr 7 :*: infixr 9 :.:

结合免费类型

2 个答案: