1

这是对是否可以扩展免费的单子解释器的后续行动？或者反过来更好。

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

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

笔记：

  • 在这一点上，我只是在寻找有关如何实现这一目标的线索。
  • 我还没有可以提供的代码。
  • 请参阅链接问题中的代码和数据类型的接受答案。
4

1 回答 1

1

类型

听起来您可能正在寻找函子的组合，它存在于变压器包中Data.Functor.Compose：

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

现在，假设其他东西之前的数据是 aString并且其他东西之后的数据是 a Int，您正在寻找类型：

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

实例

剩下的就是为、、和制作Serialize实例。其中前三个很容易，可以通过谷物包导出：FooF xSurrounded a b cCompose f g xFree f a

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实例的as 是否具有Serialize实例。

序列化1

为了检查一个函子是否有一个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 gSerialize1fmap SerializeByFfgSerialize1

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
于 2014-04-24T18:24:56.193 回答