haskell 使用4个选择器将列表解码为通用数据

vohkndzv  于 2023-11-18  发布在  其他
关注(0)|答案(1)|浏览(141)

我尝试为一个使用列表的解码器泛型地派生示例。当我在一个有多个选择器的类型上使用derive (Generic)时,选择器被关联到一个树结构中,例如对于四个构造器,它看起来像((S1 a :*: S1 b) :*: (S1 c :*: S1 d))。我不知道如何为这个写示例,即使我已经弄清楚了选择器如何关联的算法。
最小示例:

{-# language DefaultSignatures, DeriveGeneric #-}
import Data.List
import GHC.Generics
import Numeric.Natural

data Foo = Foo Int Int Int Int
    deriving (Generic, Show)

data Bar = Bar Int Int
    deriving (Generic, Show)

class Codec a where
    encode :: a -> [Int]
    default encode :: (Generic a, Codec' (Rep a)) => a -> [Int]
    encode = encode' . from
    decode :: [Int] -> a
    default decode :: (Generic a, Codec' (Rep a)) => [Int] -> a
    decode = to . decode'

class Codec' f where
    encode' :: f a -> [Int]
    decode' :: [Int] -> f a

instance Codec Int where
    encode = singleton
    decode = head

instance Codec c => Codec' (K1 i c) where
    encode' (K1 x) = encode x
    decode' x = K1 (decode x)

instance Codec' f => Codec' (M1 i t f) where
    encode' (M1 x) = encode' x
    decode' x = M1 (decode' x)

instance (Codec' f, Codec' g) => Codec' (f :*: g) where
    encode' (x :*: y) = encode' x <> encode' y
    decode' (x:xs) = decode' (singleton x) :*: decode' xs

instance Codec Foo
instance Codec Bar

main :: IO ()
main = do
    print (decode $ encode (Bar 1 2) :: Bar)
    print (decode $ encode (Foo 1 2 3 4) :: Foo)

字符串
输出量:

Bar 1 2
Foo 1 generic.hs: Prelude.head: empty list
CallStack (from HasCallStack):
  error, called at libraries/base/GHC/List.hs:1644:3 in base:GHC.List
  errorEmptyList, called at libraries/base/GHC/List.hs:87:11 in base:GHC.List
  badHead, called at libraries/base/GHC/List.hs:83:28 in base:GHC.List
  head, called at /private/tmp/generic.hs:26:14 in main:Main


预期输出:

Bar 1 2
Foo 1 2 3 4

unhi4e5o

unhi4e5o1#

注解中提出的解决方案可能会起作用,但如果你不想那么麻烦,你想重新实现你的decode/decode'对,这样它们就更像是对[Int]输入流的解析器,当它们完成工作时返回流中“未使用”的部分。也就是说,你的泛型类应该看起来像这样:

class Codec' f where
    encode' :: f a -> [Int]
    decode' :: [Int] -> (f a, [Int])

字符串
这样你就可以写:

instance (Codec' f, Codec' g) => Codec' (f :*: g) where
    encode' (x :*: y) = encode' x <> encode' y
    decode' xs = let (f, xs') = decode' xs
                     (g, xs'') = decode' xs'
                 in  (f :*: g, xs'')


其中第一子decode'可以确定在对剩余部分调用第二子decode'之前要吸收多少输入流。
完全重写的示例:

{-# LANGUAGE DefaultSignatures, DeriveGeneric #-}

import Data.List
import GHC.Generics
import Numeric.Natural
import Control.Arrow

data Foo = Foo Int Int Int Int
    deriving (Generic, Show)

data Bar = Bar Int Int
    deriving (Generic, Show)

class Codec a where
    encode :: a -> [Int]
    default encode :: (Generic a, Codec' (Rep a)) => a -> [Int]
    encode = encode' . from
    decode :: [Int] -> (a, [Int])
    default decode :: (Generic a, Codec' (Rep a)) => [Int] -> (a, [Int])
    decode = first to . decode'

class Codec' f where
    encode' :: f a -> [Int]
    decode' :: [Int] -> (f a, [Int])

instance Codec Int where
    encode = singleton
    decode (x:xs) = (x, xs)

instance Codec c => Codec' (K1 i c) where
    encode' (K1 x) = encode x
    decode' x = first K1 (decode x)

instance Codec' f => Codec' (M1 i t f) where
    encode' (M1 x) = encode' x
    decode' x = first M1 (decode' x)

instance (Codec' f, Codec' g) => Codec' (f :*: g) where
    encode' (x :*: y) = encode' x <> encode' y
    decode' xs = let (f, xs') = decode' xs
                     (g, xs'') = decode' xs'
                 in  (f :*: g, xs'')

instance Codec Foo
instance Codec Bar

main :: IO ()
main = do
    print (decode $ encode (Bar 1 2) :: (Bar, [Int]))
    print (decode $ encode (Foo 1 2 3 4) :: (Foo, [Int]))

相关问题