haskell - 是否可以重组嵌套元组？

Question

我想做的是这样的:

取一个任意的多态元组:

x = (((1, ""), Nothing), ('', 6))

并用类似这种类型的东西重新组织(不一定按相同的顺序但相同的结构。:

(Int, (Char, (Maybe Int, (String, (Int, ()))))

我真的不知道这个模式的名字，所以我无法尽我所能使用谷歌。

Answer 1

如果您只需要处理这种特定情况，即从

(((Int, String), Maybe Int), (Char, Int))

至

(Int, (Char, (Maybe Int, (String, (Int, ()))))

然后，根据您是要保留 Int -components 的顺序还是交换它们，您可以简单地使用以下两个函数之一:

from1 (((m, s), mb), (c, n)) = (m, (c, mb, (s, (n, ()))))
from2 (((m, s), mb), (c, n)) = (n, (c, mb, (s, (m, ()))))

但我们当然可以更加雄心勃勃，并以更通用的解决方案为目标；例如，参见 Jeuring and Atanassow (MPC 2004) 。为此，让我们启用一些语言扩展

{-# LANGUAGE GADTs                #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

并为我们可以用来表示元组类型的代码引入 GADT

infixr 5 :*:

data U a where
  Unit  :: U ()
  Int   :: U Int
  Char  :: U Char
  List  :: U a -> U [a]
  Maybe :: U a -> U (Maybe a)
  (:*:) :: U a -> U b -> U (a, b)

例如，您的示例中的目标类型现在可以通过表达式进行编码

Int :*: Char :*: Maybe Int :*: string :*: Int :*: Unit

类型

U (Int, (Char, (Maybe Int, (String, (Int, ()))))

为方便起见，我们介绍

string :: U String
string = List Char

我们进一步引入了一种显式类型的元组值

data Typed where
  Typed :: U a -> a -> Typed

以及类型级相等的概念:

infix 4 :==:

data a :==: b where
  Refl :: a :==: a

有了这个，我们可以定义对元组类型编码的异构相等性检查:

eq :: U a -> U b -> Maybe (a :==: b)
eq Unit Unit                   = Just Refl
eq Int Int                     = Just Refl
eq Char Char                   = Just Refl
eq (List u1) (List u2)         = case eq u1 u2 of
                                   Just Refl -> Just Refl
                                   _         -> Nothing
eq (Maybe u1) (Maybe u2)       = case eq u1 u2 of
                                   Just Refl -> Just Refl
                                   _         -> Nothing
eq (u11 :*: u12) (u21 :*: u22) = case (eq u11 u21, eq u12 u22) of
                                   (Just Refl, Just Refl) -> Just Refl
                                   _                      -> Nothing
eq _ _                         = Nothing

也就是说，如果 eq u1 u2 和 Just Refl 编码相同的元组类型，则 u1 返回 u2，否则返回 Nothing。在 Just 情况下，构造函数 Refl 充当类型检查器的证明，证明元组类型确实相同。

现在我们希望能够将元组类型转换为“扁平化”，即右嵌套表示。为此，我们引入了一个类型系列 Flatten :

type family Flatten a

type instance Flatten ()           = ()
type instance Flatten Int          = Flatten (Int, ())
type instance Flatten Char         = Flatten (Char, ())
type instance Flatten [a]          = Flatten ([a], ())
type instance Flatten (Maybe a)    = Flatten (Maybe a, ())
type instance Flatten ((), a)      = Flatten a
type instance Flatten (Int, a)     = (Int, Flatten a)
type instance Flatten (Char, a)    = (Char, Flatten a)
type instance Flatten ([a], b)     = ([a], Flatten b)
type instance Flatten (Maybe a, b) = (Maybe a, Flatten b)
type instance Flatten ((a, b), c)  = Flatten (a, (b, c))

和两个函数 flattenV 和 flattenU 分别用于展平元组值及其类型的编码:

flattenV :: U a -> a -> Flatten a
flattenV Unit _                  = ()
flattenV Int n                   = flattenV (Int :*: Unit) (n, ())
flattenV Char c                  = flattenV (Char :*: Unit) (c, ())
flattenV (List u) xs             = flattenV (List u :*: Unit) (xs, ())
flattenV (Maybe u) mb            = flattenV (Maybe u :*: Unit) (mb, ())
flattenV (Unit :*: u) (_, x)     = flattenV u x
flattenV (Int :*: u) (n, x)      = (n, flattenV u x)
flattenV (Char :*: u) (c, x)     = (c, flattenV u x)
flattenV (List _ :*: u) (xs, x)  = (xs, flattenV u x)
flattenV (Maybe _ :*: u) (mb, x) = (mb, flattenV u x)
flattenV ((u1 :*: u2) :*: u3) ((x1, x2), x3)
                                 = flattenV (u1 :*: u2 :*: u3) (x1, (x2, x3))

flattenU :: U a -> U (Flatten a)
flattenU Unit                 = Unit
flattenU Int                  = Int :*: Unit
flattenU Char                 = Char :*: Unit
flattenU (List u)             = List u :*: Unit
flattenU (Maybe u)            = Maybe u :*: Unit
flattenU (Unit :*: u)         = flattenU u
flattenU (Int :*: u)          = Int :*: flattenU u
flattenU (Char :*: u)         = Char :*: flattenU u
flattenU (List u1 :*: u2)     = List u1 :*: flattenU u2
flattenU (Maybe u1 :*: u2)    = Maybe u1 :*: flattenU u2
flattenU ((u1 :*: u2) :*: u3) = flattenU (u1 :*: u2 :*: u3)

然后将两者组合成一个函数 flatten :

flatten :: U a -> a -> Typed
flatten u x = Typed (flattenU u) (flattenV u x)

我们还需要一种方法来从扁平表示中恢复元组组件的原始嵌套:

reify :: U a -> Flatten a -> a
reify Unit _                  = ()
reify Int (n, _)              = n
reify Char (c, _)             = c
reify (List u) (xs, _)        = xs
reify (Maybe u) (mb, _)       = mb
reify (Unit :*: u) y          = ((), reify u y)
reify (Int :*: u) (n, y)      = (n, reify u y)
reify (Char :*: u) (c, y)     = (c, reify u y)
reify (List _ :*: u) (xs, y)  = (xs, reify u y)
reify (Maybe _ :*: u) (mb, y) = (mb, reify u y)
reify ((u1 :*: u2) :*: u3) y  = let (x1, (x2, x3)) = reify (u1 :*: u2 :*: u3) y
                                in  ((x1, x2), x3)

现在，给定元组组件的类型代码 u 和扁平元组及其类型的编码，我们定义函数 select ，该函数返回从元组中选择类型与 u 匹配的组件的所有可能方式以及其余组件:

select :: U b -> Typed -> [(b, Typed)]
select _ (Typed Unit _)                  = []
select u2 (Typed (u11 :*: u12) (x1, x2)) =
  case u11 `eq` u2 of
    Just Refl -> (x1, Typed u12 x2) : zs
    _         -> zs
  where
    zs = [(y, Typed (u11 :*: u') (x1, x')) |
            (y, Typed u' x') <- select u2 (Typed u12 x2)]

最后，我们可以定义一个函数 conv ，它接受两个元组类型的代码和一个与第一个代码匹配的类型的元组，并将所有可能的转换返回到一个与第二个代码匹配的类型的元组中:

conv :: U a -> U b -> a -> [b]
conv u1 u2 x = [reify u2 y | y <- go (flattenU u2) (flatten u1 x)]
  where
    go :: U b -> Typed -> [b]
    go Unit (Typed Unit _ ) = [()]
    go (u1 :*: u2) t        =
      [(y1, y2) | (y1, t') <- select u1 t, y2 <- go u2 t']

例如，我们有

conv (Int :*: Char) (Char :*: Int) (2, 'x')

产量

[('x', 2)]

回到你原来的例子，如果我们定义

from = conv u1 u2
  where
    u1 = ((Int :*: string) :*: Maybe Int) :*: Char :*: Int
    u2 = Int :*: Char :*: Maybe Int :*: string :*: Int :*: Unit

然后

from (((1, ""), Nothing), (' ', 6))

产量

[ (1, (' ', (Nothing, ("", (6, ())))))
, (6, (' ', (Nothing, ("", (1, ())))))
]

通过为可表示的元组类型引入一个类型类，我们可以让事情变得更好一点:

class Rep a where
  rep :: U a

instance Rep () where rep = Unit
instance Rep Int where rep = Int
instance Rep Char where rep = Char
instance Rep a => Rep [a] where rep = List rep
instance Rep a => Rep (Maybe a) where rep = Maybe rep
instance (Rep a, Rep b) => Rep (a, b) where rep = rep :*: rep

这样，我们可以定义一个不需要元组类型代码的转换函数:

conv' :: (Rep a, Rep b) => a -> [b]
conv' = conv rep rep

然后，例如

conv' ("foo", 'x') :: [((Char, ()), String)]

产量

[(('x', ()), "foo")]