haskell - 如何在类型族中为使用类型相等的约束定义自定义类型错误？

Question

因此，我们可以像这样定义成员资格约束:

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}

module Whatever where

type family MemberB (x :: k) (l :: [k]) where
  MemberB _ '[]      = 'False
  MemberB a (a : xs) = 'True
  MemberB a (b : xs) = MemberB a xs

type Member x xs = MemberB x xs ~ 'True

data Configuration = A | B | C

data Action (configuration :: Configuration) where
  Action1 :: Member cfg '[ 'A ]     => Action cfg
  Action2 :: Member cfg '[ 'B, 'C ] => Action cfg
  Action3 :: Member cfg '[ 'A, 'C ] => Action cfg

exhaustive :: Action 'A -> ()
exhaustive Action1 = ()
exhaustive Action3 = ()
exhaustive Action2 = ()

但是我们收到的错误消息信息并不丰富:

 • Couldn't match type ‘'False’ with ‘'True’
   Inaccessible code in
     a pattern with constructor:
       Action2 :: forall (cfg :: Configuration).
                  Member cfg '['B, 'C] =>
                  Action cfg,
     in an equation for ‘exhaustive’
 • In the pattern: Action2
   In an equation for ‘exhaustive’: exhaustive Action2 = () (intero)

使用新的 TypeError 功能来改进此消息会很好，但是，一个简单的解决方案会吞噬该错误:

import GHC.TypeLits

type family MemberB (x :: k) (l :: [k]) where
  MemberB _ '[]      = TypeError ('Text "not a member")
  MemberB a (a : xs) = 'True
  MemberB a (b : xs) = MemberB a xs

看来，TypeError 的行为可能与任何类型相同，因此它可以与 'True 愉快地结合起来？

有没有办法在保留成员资格行为的同时获得良好的类型错误？

Answer 1

嗯，它不使用 TypeError，但您可能会发现它很有趣:

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}

module Whatever where

data IsMember k = IsMember | Isn'tMember k [k]

type family MemberB (x :: k) (l :: [k]) (orig :: [k]) where
  MemberB a '[]      ys = 'Isn'tMember a ys
  MemberB a (a : xs) ys = 'IsMember
  MemberB a (b : xs) ys = MemberB a xs ys

type Member x xs = MemberB x xs xs ~ 'IsMember

data Configuration = A | B | C

data Action (configuration :: Configuration) where
  Action1 :: Member cfg '[ 'A ]     => Action cfg
  Action2 :: Member cfg '[ 'B, 'C ] => Action cfg
  Action3 :: Member cfg '[ 'A, 'C ] => Action cfg

exhaustive :: Action 'A -> ()
exhaustive Action1 = ()
exhaustive Action3 = ()
exhaustive Action2 = ()

现在该错误信息更丰富了:

test.hs:32:16: error:
    • Couldn't match type ‘'Isn'tMember 'A '['B, 'C]’ with ‘'IsMember’
      Inaccessible code in
        a pattern with constructor:
          Action2 :: forall (cfg :: Configuration).
                     Member cfg '['B, 'C] =>
                     Action cfg,
        in an equation for ‘exhaustive’
    • In the pattern: Action2
      In an equation for ‘exhaustive’: exhaustive Action2 = ()
   |
32 |     exhaustive Action2 = ()
   |                ^^^^^^^