bhe*_*ilr 18 monads haskell free-monad
我最近一直在教自己关于免费套餐中的Freemonad ,但我遇到了一个问题.我想为不同的库提供不同的免费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
Run Code Online (Sandbox Code Playgroud)
现在,我希望能够创建一个类型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
Run Code Online (Sandbox Code Playgroud)
但是以这种方式Bells并且Whistles可以存在于单独的模块中而不必了解彼此的实现.我的想法是,我可以为不同的任务编写独立模块,每个模块都实现自己的DSL,然后根据需要将它们组合成"更大"的DSL.是否有捷径可寻?
作为奖励,能够利用play*已经编写的不同功能是非常好的,这样我就可以将它们交换出来.我希望能够使用一个免费的解释器进行调试,另一个用于生产,显然可以选择单独调试哪个DSL.
Gab*_*lez 29
这是一个基于纸张数据类型单点的答案,除了没有类型类.我建议阅读那篇论文.
诀窍在于,不是为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
Run Code Online (Sandbox Code Playgroud)
如果您选择不将它们组合在一起,您可以将它们传递给Control.Monad.Free.iterM原来的播放功能:
playBells :: Bells a -> IO a
playBells = iterM playBell
playWhistles :: Whistles a -> IO a
playWhistles = iterM playWhistlesF
Run Code Online (Sandbox Code Playgroud)
...但是因为他们处理单个步骤,所以可以更容易地组合.您可以像这样定义一个新的组合免费monad:
data BellsAndWhistlesF a = L (BellsF a) | R (WhistlesF a)
Run Code Online (Sandbox Code Playgroud)
然后把它变成一个免费的monad:
type BellsAndWhistles = Free BellsAndWhistlesF
Run Code Online (Sandbox Code Playgroud)
然后你BellsAndWhistlesF就两个子解释器的一个步骤编写一个解释器:
playBellsAndWhistlesF :: BellsAndWhistlesF (IO a) -> IO a
playBellsAndWhistlesF (L bs) = playBellsF bs
playBellsAndWhistlesF (R ws) = playWhistlesF ws
Run Code Online (Sandbox Code Playgroud)
...然后你通过传递到以下内容获得免费monad的解释器iterM:
playBellsAndWhistles :: BellsAndWhistles a -> IO a
playBellsAndWhistles = iterM playBellsAndWhistlesF
Run Code Online (Sandbox Code Playgroud)
因此,您的问题的答案是,组合免费monad的技巧是通过为各个函子步骤("代数")定义中间解释器来保留更多信息.这些"代数"比免费monad的解释器更适合组合.
Lui*_*las 17
加布里埃尔的回答很明显,但我认为有必要更多地强调让它全部发挥作用的事情,即两个Functors 的总和也是Functor:
-- | 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
Run Code Online (Sandbox Code Playgroud)
(Edward Kmett的图书馆有这个Data.Functor.Coproduct.)
因此,如果Functors是Freemonad 的"指令集" ,那么:
elimSum函数是一个基本规则,允许您Sum f g从解释器f和一个解释器构建一个解释器g.在"数据类型点菜 "技术,当你发展这个你正是洞察,这是非常值得的,同时只工作了手.
这种Functor代数是值得学习的东西.例如:
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)
Run Code Online (Sandbox Code Playgroud)
Gershom Bazerman的博客文章"Abstracting with Applicatives"扩展了关于Applicatives的这些观点,非常值得一读.
编辑:最后我要注意的是,当人们Functor为他们的免费monad 设计他们的自定义时,事实上,隐含地他们正在使用这些技术.我将从Gabriel的"为什么免费monad重要"中拿两个例子:
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)
Run Code Online (Sandbox Code Playgroud)
所有这些都可以分析到的一些组合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
Run Code Online (Sandbox Code Playgroud)
因此,为简洁起见,使用以下类型的同义词:
{-# 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 :.:
Run Code Online (Sandbox Code Playgroud)
...我们可以像这样重写那些仿函数:
type Toy b = Const b :*: Identity :+: Identity :+: VoidF
type Interaction = Const Direction :*: ((->) Image :.: Identity)
:+: Const Direction :*: Identity
:+: (->) String :.: Identity
:+: Const String :*: ((->) Bool :.: Identity)
Run Code Online (Sandbox Code Playgroud)