Question

这是Is it possible to extend free monad interpreters?的后续行动，反之亦然。

我最近重新审视了上一个问题源自的项目。这次我尝试将文件解析为数据结构。

问题是我不知道如何实现这一目标。虽然编写he（基于cereal）解析器是没有问题的，但只要我只解析为FooF类型它就可以工作，我不知道如何创建交错的Functor （正确的术语？）。

注意：

此时我只想找到如何实现这一目标的线索。
我无法提供任何代码。
请参阅链接问题中的代码和数据类型的接受答案。

Answer 1

类型

听起来你可能正在寻找仿函数的组合，它位于Data.Functor.Compose的{{3}}包中：

newtype Compose f g a = Compose { getCompose :: f (g a) }

如果我正确理解了您的两个问题，您希望在其他内容之前和之后添加内容，然后将添加的数据解析出来。我们会在其他内容之前和之后添加一些类型

data Surrounded a b c = Surrounded a c b
  deriving (Functor)

surround :: a -> b -> c -> Surrounded a b c
surround a b c = Surrounded a c b

现在，假设其他内容之前的数据为String而其他内容之后的数据为Int，则您需要查找类型：

Free (Compose (Surrounded String Int) FooF) :: * -> *

实例

剩下的就是为Serialize，FooF x，Surrounded a b c和Compose f g x制作Free f a个实例。前三个很容易，可以通过transformers得出：

deriving instance Generic (FooF x)
instance Serialize x => Serialize (FooF x)

deriving instance Generic (Surrounded a b c)
instance (Serialize a, Serialize b, Serialize c) => Serialize (Surrounded a b c)

deriving instance Generic (Compose f g a)
instance (Serialize (f (g a))) => Serialize (Compose f g a)

如果我们尝试对Free执行相同的操作，我们会写instance (Serialize a, Serialize (f (Free f a))) => Serialize (Free f a)。我们遇到UndecidableInstances领土;要为Serialize制作Free个实例，我们首先必须为Serialize设置Free个实例。我们希望通过归纳证明该实例已存在，但为此，我们需要能够检查f a是否有Serialize个实例a 1}}具有Serialize实例。

Serialize1

要检查仿函数是否具有Serialize实例，只要它的参数具有Serialize实例，我们就会引入一个新的类型类Serialize1。对于那些Serialize实例已根据参数的Serialize实例定义的仿函数，我们可以按default生成新的序列化实例。

class Serialize1 f where
    put1 :: Serialize a => Putter (f a)
    get1 :: Serialize a => Get (f a)

    default put1 :: (Serialize a, Serialize (f a)) => Putter (f a)
    put1 = put

    default get1 :: (Serialize a, Serialize (f a)) => Get (f a)
    get1 = get

前两个仿函数FooF和Surround a b可以使用新类的默认实例：

instance Serialize1 FooF

instance (Serialize a, Serialize b) => Serialize1 (Surrounded a b)

Compose f g需要一些帮助。

-- Type to help defining Compose's Serialise1 instance
newtype SerializeByF f a = SerializeByF { unSerialiseByF :: f a }

instance (Serialize1 f, Serialize a) => Serialize (SerializeByF f a) where
    put = put1 . unSerialiseByF
    get = fmap SerializeByF get1

instance (Serialize1 f) => Serialize1 (SerializeByF f)

现在，我们可以通过其他两个Serialize1实例序列化来为Compose f g定义Serialize1个实例。 fmap SerializeByF标记f要由g Serialize1个实例序列化的内部数据。

instance (Functor f, Serialize1 f, Serialize1 g) => Serialize1 (Compose f g) where
    put1 = put . SerializeByF . fmap SerializeByF . getCompose
    get1 = fmap (Compose . fmap unSerializeByF . unSerializeByF ) get

免费序列化

现在我们应该为Serialize制作Free f a个实例。我们将借用Either a (SerializeByF f (Free f a))的序列化。

toEitherRep :: Free f a => Either a (SerializeByF f (Free f a))
toEitherRep (Pure a) = Left a
toEitherRep (Free x) = Right (SerializeByF x)

fromEitherRep :: Either a (SerializeByF f (Free f a)) => Free f a
fromEitherRep = either Pure (Free . unSerializeByF)

instance (Serialize a, Serialize1 f) => Serialize (Free f a) where
    put = put . toEitherRep    
    get = fmap fromEitherRep get

instance (Serialize1 f) => Serialize1 (Free f)

实施例

现在我们可以序列化和反序列化：

example :: Free (Compose (Surrounded String Int) FooF) ()
example = Free . Compose . surround "First" 1 . Foo "FirstFoo" . Free . Compose . surround "Second" 2 . Bar 22 . Pure $ ()

样板

上述内容需要以下扩展名

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}

以及以下图书馆：

import Control.Monad.Free
import Data.Functor.Compose
import Data.Serialize
import GHC.Generics

是否可以扩展免费的monad解析器？

1 个答案:

类型

实例

Serialize1

免费序列化

实施例

样板