如何制作同参数化类型的异构类型的容器？

Question

我正在努力实现这样的目标：

我有一个参数化类型，我们称之为变量。这是一个函子 然后我想要一个变量容器（任何变量、变量 Int、变量 Double、变量字符串等）

我希望这个容器也是一个 Functor。

我设法制作了一个参数化容器 FooContainer，但我想处理异构类型。

所以我创建了 Bar 代数数据类型和 BarContainer。 （这里建议https://wiki.haskell.org/Heterogenous_collections#Algebraic_datatypes） 但我不明白如何使 BarContainer 成为 Functor，因为它的构造函数没有参数。

import Data.List

data Variable a  =  Variable { 
 varName :: String
 ,value  :: [a] } deriving (Show,Read,Eq)

instance  Functor Variable where
 fmap f (Variable name vals ) = Variable  name (fmap f vals)


data FooContainer a = FooContainer {
 fooname:: String
 , pdata :: [Variable a]
 } deriving (Show,Read,Eq)

instance  Functor FooContainer where
 fmap f (FooContainer n p ) = FooContainer n ( Data.List.map (\x-> fmap f x)  p)

data Bar = BarInt [Int] | BarDouble [Double] | BarString  [String] | BarChar [Char] deriving (Show,Read,Eq)

data BarContainer = BarContainer {
 nameB:: String
 , pdataB :: [Bar]
 } deriving (Show,Read,Eq)




fooC = FooContainer "foo Container" [Variable "v1" [5,6], Variable "v2" [2,6,8]]
fooC_plus2 = fmap (+2) fooC


barC = BarContainer "bar Container" [ BarInt [5,1], BarDouble [3.2,2,6], BarString ["bob", "dupont"]]
--barC_plus2 ? 


main = print $ "Hello, world!" ++ ( show fooC_plus2) ++ (show barC)

Answer 1

您需要一个包含String 名称的容器，然后是不同类型的Values 列表。您使用Bar 的方式仅限于某些类型的Variable。如果你想要一个真正的、不受限制的异构容器，你需要一个 GADT。

data HMapList (f :: k -> Type) (xs :: [k]) :: Type where
  HMNil :: HMapList f '[]
  HMCons :: f x -> HMapList f xs -> HMapList f (x : xs)

data Container xs = Container {
   containerName :: String
 , containerValues :: HMapList Variable xs
 }

Functor 在这里是不可能的。密切相关的是镜头的概念，你可以得到它。 “正确”地执行此操作需要一些样板：

data Elem (x :: k) (xs :: [k]) where -- where do I find x in xs?
  Here :: Elem x (x : xs)
  There :: Elem x xs -> Elem x (y : xs)
data SElem (e :: Elem (x :: k) xs) where
  SHere :: SElem Here
  SThere :: SElem e -> SElem (There e)
-- these are like indices: think 0 = (S)Here, 1 = (S)There (S)Here, 2 = (S)There 1, etc.

type family Replace (xs :: [k]) (e :: Elem x xs) (y :: k) :: [k] where
  Replace (_ : xs) Here y = y : xs
  Replace (x : xs) (There e) y = x : Replace xs e y

hmLens :: forall x y xs (e :: Elem x xs) f g. Functor g => SElem e ->
          -- Lens (f x) (f y) (HMapList f xs) (HMapList f (Replace xs e y))
          (f x -> g (f y)) -> HMapList f xs -> g (HMapList f (Replace xs e y))
hmLens SHere mod (HMCons fx xs) = (\fx' -> HMCons fx' xs) <$> mod fx
hmLens (SThere e) mod (HMCons fx xs) = (\xs' -> HMCons fx xs') <$> hmLens e mod xs

hmLens 代表HMapList 的“字段”。您可以使用lens 库中的运算符来操作包含在Container 的“槽”中的f x，并完成类型更改。也就是说，一旦您在列表中选择了带有Elem 的位置，您就可以使用Functory 将as 替换为bs，方法是使用a -> b。不过，Container 本身并不是函子。相反，它生成了一个无限的函子家族，比我更有经验的人可能会说出它们的名字。执行您的示例：

container :: Container [Int, Double, String]
container = Container "container" $ HMCons (Variable "v1" [5,1]) $
                                    HMCons (Variable "v2" [3.2,2,6]) $
                                    HMCons (Variable "v3" ["bob", "dupont"])
                                    HMNil
container' :: Container [Int, Double, String]
container' = let Container name vs = container
              in Container name $ vs & (hmLens SHere).mapped %~ (+2)
              --                       ^ access 1st field    ^ modify w/ function
              --                     ^ flip ($)       ^ peek into Variable
-- a proper Lens (Container xs) (Container ys) (HMapList Variable xs) (HMapList Variable ys)
-- would alleviate the match/rebuild pain.

如果您想扩展它以将(+2) 应用于Container 内的所有Variable Ints（可能会更改类型，例如使用show），那么您可以调整@ 的一部分987654321@.

Container 也是一个正确的小写“f”函子。让我定义一类类别：

data ZippingWith (f :: a -> b -> Type) (as :: [a]) (bs :: [b]) where
  ZWNil :: ZippingWith f '[] '[]
  ZWCons :: f a b -> ZippingWith f as bs -> ZippingWith f (a : as) (b : bs)

如果f :: k -> k -> Type 本身标识了一个类别，那么ZippingWith f 也是如此。在xs 和ys 之间的ZippingWith f-arrow 是xs 和ys 的元素之间的f-arrows 列表，采用“zippy”方式。 HMapList f（和Container，因此）是从ZippingWith (On f (->)) 到(->) 的函子。它将函数列表提升为列表中的函数。

newtype On (f :: i -> o) (arr :: o -> o -> Type) (a :: i) (b :: i)
  = On { runOn :: arr (f a) (f b) }

hmMap :: (ZippingWith (On f (->))) xs              ys              ->
         (->)                      (HMapList f xs) (HMapList f ys)
hmMap ZWNil HMNil = HMNil
hmMap (ZWCons (On axy) as) (HMCons fx xs) = HMCons (axy fx) (hmMap as xs)
containerMap :: (ZippingWith (On Variable (->))) xs             ys             ->
                (->)                             (Container xs) (Container ys)
containerMap as (Container name vs) = Container name (hmMap as vs)

如果f 本身是一个Functor（在这种情况下就是这样），你会得到一些从ZippingWith (->) 到ZippingWith (On f (->)) 的提升动作

zwManyMap :: Functor f => ZippingWith (->) xs ys -> ZippingWith (On f (->)) xs ys
zwManyMap ZWNil = ZWNil
zwManyMap (ZWCons axy as) = ZWCons (On (fmap axy)) (zwManyMap as)

这给了我们更多的功能：

hmMapMap :: Functor f =>
            (ZippingWith (->)) xs              ys              ->
            (->)               (HMapList f xs) (HMapList f ys)
hmMapMap = hmMap . zwManyMap
containerMapMap :: (ZippingWith (->)) xs             ys             ->
                   (->)               (Container xs) (Container ys)
containerMapMap = containerMap . zwManyMap

但是等等；还有更多：函子类别是一个类别，其中对象是函子（f，g），箭头是自然变换（f ~> g = forall a. f a -> g a）。 HMapList 实际上是一个双函子。您已经看到了 ZippingWith (On f (->)) 到 (->) 函子。现在查看 (~>) 到 (->) 函子。

hmLMap :: (forall x. f x -> g x) ->
          HMapList f xs -> HMapList g xs
hmLMap _ HMNil = HMNil
hmLMap f (HMCons fx xs) = HMCons (f fx) (hmLMap f xs)

这个不能泛化到Container，除非你重新定义它：

data Container f xs = Container {
    containerName :: String
  , containerValues :: HMapList f xs
  }

如果您确实选择保留您的 BarContainer 表示，containerMap 和 containerMapMap 会降级为一些可用的残余。再说一次，它们更注重镜头而不是敷衍，但它们是可行的。

-- "type-changing": e.g. BarInt can become BarChar, if desired
containerMapChanging :: ([Int] -> Bar) -> ([Double] -> Bar) ->
                        ([String] -> Bar) -> ([Char] -> Bar) ->
                        BarContainer -> BarContainer
containerMapChanging i d s c (BarContainer name bs) = BarContainer name (f <$> bs)
  where f (BarInt x) = i x
        f (BarDouble x) = d x
        f (BarString x) = s x
        f (BarChar x) = c x

containerMap :: ([Int] -> [Int]) -> ([Double] -> [Double]) ->
                ([String] -> [String]) -> ([Char] -> [Char]) ->
                BarContainer -> BarContainer
containerMap i d s c bc = containerMapChanging (BarInt . i) (BarDouble . d)
                                               (BarString . s) (BarChar . c)
                                               bc

containerMapMap :: (Int -> Int) -> (Double -> Double) ->
                   (String -> String) -> (Char -> Char) ->
                   BarContainer -> BarContainer
containerMapMap i d s c bc = containerMap (map i) (map d) (map s) (map c) bc

所以，例如如果我想将2 添加到BarContainer 中的每个Int 并删除每个String 的第一个字符，我可以使用containerMapMap (+2) id tail id。

Answer 2

（这更像是评论而不是答案，但我需要更多空间。）

这样的容器似乎不可能实现，但也许你对类似的东西没问题。

问题 1： 假设我们有一个异构容器c，其中包含Variable Int 和Variable String 的混合物。然后，考虑任何f :: Int -> Int（比如f = succ）。

fmap f c 会是什么？我们不能将f 应用于所有变量。 f 是否仅适用于 Int ？这将需要一些运行时类型检查，即我们需要在这里和那里添加Typeable 约束，但Functor 不允许在fmap 上添加这样的约束。

问题 2：

要使用fmap f c，参数c 必须具有类型Container T 用于某些类型T。索引T 应该是什么？

也许根本没有索引。也许索引是异构容器内类型的类型级列表。例如。 Container '[Int,Int,String,Int].

无论如何，Functor 不能用这个。

也许你想要的是一个自定义函数，比如

notFmap :: (Typeable a, Typeable b) => (a -> b) -> Container -> Container

或

notFmap :: (a -> b) -> Container t -> Container (Replace a b t)

Replace 是处理索引列表t 并将a 替换为b 的合适类型族。