使用Data Kinds使用GADT動態構建值

Question

為什么使用datakinds構建值更難，而與它們進行模式匹配相對容易？

{-# LANGUAGE  KindSignatures
            , GADTs
            , DataKinds
            , Rank2Types
 #-}

data Nat = Zero | Succ Nat

data Direction = Center | Up | Down | UpDown deriving (Show, Eq)

data Chain :: Nat -> Nat -> * -> * where
    Nil    :: Chain Zero Zero a
    AddUp  :: a -> Chain nUp nDn a -> Chain (Succ nUp) nDn a
    AddDn  :: a -> Chain nUp nDn a -> Chain nUp (Succ nDn) a
    AddUD  :: a -> Chain nUp nDn a -> Chain (Succ nUp) (Succ nDn) a
    Add    :: a -> Chain nUp nDn a -> Chain nUp nDn a

lengthChain :: Num b => Chain (Succ Zero) (Succ Zero) a -> b
lengthChain = lengthChain'

lengthChain' :: forall (t::Nat) (t1::Nat) a b. Num b => Chain t t1 a -> b
lengthChain' Nil = 0
lengthChain' (Add   _ rest) = 1 + lengthChain' rest
lengthChain' (AddUp _ rest) = 1 + lengthChain' rest
lengthChain' (AddDn _ rest) = 1 + lengthChain' rest
lengthChain' (AddUD _ rest) = 1 + lengthChain' rest

chainToList :: Chain (Succ Zero) (Succ Zero) a -> [(a, Direction)]
chainToList = chainToList'

chainToList' :: forall (t::Nat) (t1::Nat) a. Chain t t1 a -> [(a, Direction)]
chainToList' Nil = []
chainToList' (Add a rest) = (a, Center):chainToList' rest
chainToList' (AddUp a rest) = (a, Up):chainToList' rest
chainToList' (AddDn a rest) = (a, Down):chainToList' rest
chainToList' (AddUD a rest) = (a, UpDown):chainToList' rest

listToChain :: forall (t::Nat) (t1::Nat) b. [(b, Direction)] -> Chain t t1 b
listToChain ((x, Center): xs) = Add x (listToChain xs)
listToChain ((x, Up):xs) = AddUp x (listToChain xs)
listToChain ((x, Down): xs) = AddDn x (listToChain xs)
listToChain ((x, UpDown): xs) = AddUD x (listToChain xs)
listToChain _ = Nil

我正在嘗試構建一個數據類型來控制類似於列表的結構，不同之處在於我們可能會向元素添加箭頭。 此外，我要求某些功能僅在向上箭頭和向下箭頭的數量正好等於1的列表上運行。

在上面的代碼中，函數listToChain無法編譯，而chainToList正常編譯。 我們如何修復listToChain代碼？

Answer 1

如果你考慮一下，你會發現listToChain的類型無法工作，因為它接收的(b, Direction)值沒有方向的類型級別信息，它仍然應該以某種方式在編譯時計算出結果Chain的方向索引類型。 這顯然是不可能的，因為在運行時，值可以由用戶輸入或從插座等讀取。

您需要跳過中間列表並直接從編譯時驗證的值構建鏈，或者您可以將結果鏈包裝在存在類型中並執行運行時檢查以將存在性更新為更精確的類型。

所以，給定一個存在的包裝器

data SomeChain a where
    SomeChain :: Chain nu nd a -> SomeChain a

你可以實現listToChain

listToChain :: [(b, Direction)] -> SomeChain b
listToChain ((x, Center): xs) = withSome (SomeChain . Add x)   (listToChain xs)
listToChain ((x, Up):xs)      = withSome (SomeChain . AddUp x) (listToChain xs)
listToChain ((x, Down): xs)   = withSome (SomeChain . AddDn x) (listToChain xs)
listToChain ((x, UpDown): xs) = withSome (SomeChain . AddUD x) (listToChain xs)
listToChain _                 = SomeChain Nil

使用輔助函數withSome可以更方便地包裝和展開存在物。

withSome :: (forall nu nd. Chain nu nd b -> r) -> SomeChain b -> r
withSome f (SomeChain c) = f c

現在我們有一個存在主義，我們可以傳遞，隱藏精確的上下類型。 當我們想調用像lengthChain這樣需要特定向上和向下計數的函數時，我們需要在運行時驗證內容。 一種方法是定義一個類型類。

class ChainProof pnu pnd where
    proveChain :: Chain nu nd b -> Maybe (Chain pnu pnd b)

proveChain函數接受任何nu和nd的鏈，並試圖證明它符合特定的pnu和pnd 。 實現ChainProof需要一些重復的樣板，但它可以提供任何所需的起伏組合的證據，以及我們需要的lengthChain的一個案例。

instance ChainProof Zero Zero where
    proveChain Nil          = Just Nil
    proveChain (Add a rest) = Add a <$> proveChain rest
    proveChain _            = Nothing

instance ChainProof u Zero => ChainProof (Succ u) Zero where
    proveChain (Add a rest)   = Add a   <$> proveChain rest
    proveChain (AddUp a rest) = AddUp a <$> proveChain rest
    proveChain _              = Nothing

instance ChainProof Zero d => ChainProof Zero (Succ d) where
    proveChain (Add a rest)   = Add a   <$> proveChain rest
    proveChain (AddDn a rest) = AddDn a <$> proveChain rest
    proveChain _              = Nothing

instance (ChainProof u (Succ d), ChainProof (Succ u) d, ChainProof u d) => ChainProof (Succ u) (Succ d) where
    proveChain (Add a rest)   = Add a   <$> proveChain rest
    proveChain (AddUp a rest) = AddUp a <$> proveChain rest
    proveChain (AddDn a rest) = AddDn a <$> proveChain rest
    proveChain (AddUD a rest) = AddUD a <$> proveChain rest
    proveChain _              = Nothing

以上需要語言擴展MultiParamTypeClasses和FlexibleContexts ，我使用Control.Applicative <$> 。

現在我們可以使用證明機制為任何期望特定向上和向下計數的函數創建一個安全的包裝器

safe :: ChainProof nu nd => (Chain nu nd b -> r) -> SomeChain b -> Maybe r
safe f = withSome (fmap f . proveChain)

這似乎是一個令人不滿意的解決方案，因為我們仍然需要處理故障情況（即Nothing ），但至少只需要在頂級檢查。 在給定的f內部，我們對鏈的結構有靜態保證，不需要進行任何額外的驗證。

替代方案

上述解決方案雖然易於實現，但每次驗證時都必須遍歷並重新構建整個鏈。 另一個選擇是將上下計數存儲為存在主義中的單身自然。

data SNat :: Nat -> * where
    SZero :: SNat Zero
    SSucc :: SNat n -> SNat (Succ n)

data SomeChain a where
    SomeChain :: SNat nu -> SNat nd -> Chain nu nd a -> SomeChain a

的SNat類型是值水平相當於所述的Nat種類，使得為每種類型的種Nat有類型的一個值SNat這意味着即使當類型t的SNat t被擦除時，可以充分通過圖案匹配恢復它在價值上。 通過擴展，這意味着我們可以通過僅僅在自然界上進行模式匹配來恢復存在主義中的完整類型的Chain ，而不必遍歷鏈本身。

建立鏈條變得更加冗長

listToChain :: [(b, Direction)] -> SomeChain b
listToChain ((x, Center): xs) = case listToChain xs of
    SomeChain u d c -> SomeChain u d (Add x c)
listToChain ((x, Up):xs)      = case listToChain xs of
    SomeChain u d c -> SomeChain (SSucc u) d (AddUp x c)
listToChain ((x, Down): xs)   = case listToChain xs of
    SomeChain u d c -> SomeChain u (SSucc d) (AddDn x c)
listToChain ((x, UpDown): xs) = case listToChain xs of
    SomeChain u d c -> SomeChain (SSucc u) (SSucc d) (AddUD x c)
listToChain _                 = SomeChain SZero SZero Nil

但另一方面，證據變得更短（雖然有點毛茸茸的類型簽名）。

proveChain :: forall pnu pnd b. (ProveNat pnu, ProveNat pnd) => SomeChain b -> Maybe (Chain pnu pnd b)
proveChain (SomeChain (u :: SNat u) (d :: SNat d) c)
    = case (proveNat u :: Maybe (Refl u pnu), proveNat d :: Maybe (Refl d pnd)) of
        (Just Refl, Just Refl) -> Just c
        _ -> Nothing

這使用ScopedTypeVariables顯式選擇我們想要使用的ProveNat的類型類實例。 如果我們得到自然符合所請求值的證據，那么類型檢查器很樂意讓我們返回Just c而不進一步檢查它。

ProveNat定義為

{-# LANGUAGE PolyKinds #-}

data Refl a b where
    Refl :: Refl a a

class ProveNat n where
    proveNat :: SNat m -> Maybe (Refl m n)

該Refl類型（反身性）是一種常用的模式進行類型檢查統一兩名身份不明的類型，當我們在模式匹配Refl構造函數（和PolyKinds允許它通用於任何類型的，讓我們用它Nat S）。 因此，雖然proveNat接受forall m. SNat m forall m. SNat m如果我們之后可以在Just Refl forall m. SNat m進行模式匹配，我們（更重要的是，類型檢查器）可以確定m和n實際上是相同的類型。

ProveNat的實例非常簡單，但同樣需要一些顯式類型來幫助推理。

instance ProveNat Zero where
    proveNat SZero = Just Refl
    proveNat _ = Nothing

instance ProveNat n => ProveNat (Succ n) where
    proveNat m@(SSucc _) = proveNat' m where
        proveNat' :: forall p. ProveNat n => SNat (Succ p) -> Maybe (Refl (Succ p) (Succ n))
        proveNat' (SSucc p) = case proveNat p :: Maybe (Refl p n) of
            Just Refl -> Just Refl
            _         -> Nothing
    proveNat _ = Nothing

Answer 2

問題不在於datakinds。 在類型中

listToChain :: forall (t::Nat) (t1::Nat) b. [(b, Direction)] -> Chain t t1 b

你是說對於任何類型t t1 b你可以將一對b和方向的列表變成一個Chain t t1 b ...但是你的函數不是這樣，例如：

listToChain _ = Nil

結果不適用於任何類型，但僅當t, t1都Zero 。 這是GADT的重點，它限制了可能的類型。

我懷疑你想給你的函數類型是一個依賴類型 ，類似於

listToChain :: (x :: [(b,Direction)]) -> Chain (number_of_ups x) (number_of_downs x) b

但這在Haskell中不是有效的，因為Haskell沒有依賴類型。 一種解決方案是使用存在主義

listToChain :: forall b. [(b, Direction)] -> exists (t :: Nat) (t1 :: Nat). Chain t t1 b

這幾乎是有效的Haskell。 不幸的是，存在感需要包含在構造函數中

data AChain b where
   AChain :: Chain t t1 b -> AChain b

然后你就可以這樣做：

listToChain :: forall b. [(b, Direction)] -> AChain b
listToChain ((x, Center): xs) = case (listToChain xs) of
   AChain y -> AChain (Add x y) 
...