Haskell 约束闭式族

我能让编译器相信封闭类型族中的类型同义词总是满足约束吗？族由一组有限的提升值建立索引

类似于

data NoShow = NoShow
data LiftedType = V1 | V2 | V3

type family (Show (Synonym (a :: LiftedType)) => Synonym (a :: LiftedType)) where
  Synonym V1 = Int
  Synonym V2 = NoShow -- no Show instance => compilation error
  Synonym V3 = ()

data YesNo = Yes | No
class Foo (yn :: YesNo) where foo :: Proxy yn -> Bool
type family (Foo (T t) => T t) where
    T X = Yes
    T y = No

f :: forall t. Proxy t -> Bool
f _ = foo (Proxy (T t))

我可以对开放式族强制执行约束：

class (Show (Synonym a)) => SynonymClass (a :: LiftedType) where
  type Synonym a
  type Synonym a = ()

instance SynonymClass Int where
  type Synonym V1 = Int

-- the compiler complains here
instance SynonymClass V2 where
  type Synonym V2 = NoShow

instance SynonymClass V3

但是编译器必须能够推理这样一个事实，即对于

V1

、

V2

和

V3

中的每一个，都存在一个

a类

的实例？但在任何情况下，我都不希望使用开放式族

我要求这样做的动机是，我想让编译器相信代码中封闭类型族的所有实例都有Show/Read实例。一个简化的例子是：

parseLTandSynonym :: LiftedType -> String -> String
parseLTandSynonym lt x =
  case (toSing lt) of
    SomeSing (slt :: SLiftedType lt') -> parseSynonym slt x

parseSynonym :: forall lt. SLiftedType lt -> String -> String
parseSynonym slt flv =
      case (readEither flv :: Either String (Synonym lt)) of
        Left err -> "Can't parse synonym: " ++ err
        Right x  -> "Synonym value: " ++ show x 

---

[有人在评论中提到这是不可能的-这是因为技术上不可能（如果是，为什么）还是GHC实现的一个限制？]

问题是我们不能将

同义词

放在实例头中，因为它是一个类型族，我们不能编写像

这样的“通用量化”约束（forall x.Show（同义词x））=>…

，因为Haskell中没有这样的东西

但是，我们可以使用两种方法：

• 对于所有x.f x->a

  相当于

  （存在x.f x）->a

• singleton

  的去功能化允许我们将类型族放入实例头中

因此，我们定义了一个适用于

单例类型函数的存在包装器：

data Some :: (TyFun k * -> *) -> * where
  Some :: Sing x -> f @@ x -> Some f

我们还包括
LiftedType
的故障符号：

import Data.Singletons.TH
import Text.Read
import Control.Applicative

$(singletons [d| data LiftedType = V1 | V2 | V3 deriving (Eq, Show) |])

type family Synonym t where
  Synonym V1 = Int
  Synonym V2 = ()
  Synonym V3 = Char

data SynonymS :: TyFun LiftedType * -> * -- the symbol for Synonym
type instance Apply SynonymS t = Synonym t

现在，我们可以使用
一些同义词->a
而不是
来表示所有的x。同义词x->a
，这种形式也可以在实例中使用

instance Show (Some SynonymS) where
  show (Some SV1 x) = show x
  show (Some SV2 x) = show x
  show (Some SV3 x) = show x

instance Read (Some SynonymS) where
  readPrec = undefined -- I don't bother with this now...

parseLTandSynonym :: LiftedType -> String -> String
parseLTandSynonym lt x =
  case (toSing lt) of
    SomeSing (slt :: SLiftedType lt') -> parseSynonym slt x

parseSynonym :: forall lt. SLiftedType lt -> String -> String
parseSynonym slt flv =
      case (readEither flv :: Either String (Some SynonymS)) of
        Left err -> "Can't parse synonym: " ++ err
        Right x  -> "Synonym value: " ++ show x 

这并不能直接为我们提供任何特定的
t
选择
Read（同义词t）
，尽管我们仍然可以读取
一些同义词
，然后在存在标记上进行模式匹配以检查我们是否得到了正确的类型（如果不正确则失败）。这几乎涵盖了
Read
的所有用例

如果这还不够好，我们可以使用另一个包装器，将
一些f
实例提升为“通用量化”实例

data At :: (TyFun k * -> *) -> k -> * where
  At :: Sing x -> f @@ x -> At f x

At fx
相当于
f@@x
，但我们可以为它编写实例。特别是，我们可以在这里编写一个合理的通用
Read
实例

instance (Read (Some f), SDecide (KindOf x), SingKind (KindOf x), SingI x) =>
  Read (At f x) where
    readPrec = do
      Some tag x <- readPrec :: ReadPrec (Some f)
      case tag %~ (sing :: Sing x) of
        Proved Refl -> pure (At tag x)
        Disproved _ -> empty

我们还可以使
At
和
Some
之间的转换更容易一些：

curry' :: (forall x. At f x -> a) -> Some f -> a
curry' f (Some tag x) = f (At tag x)

uncurry' :: (Some f -> a) -> At f x -> a
uncurry' f (At tag x) = f (Some tag x)

parseSynonym :: forall lt. SLiftedType lt -> String -> String
parseSynonym slt flv = withSingI slt $ 
      case (readEither flv :: Either String (At SynonymS lt)) of
        Left err -> "Can't parse synonym: " ++ err
        Right atx  -> "Synonym value: " ++ uncurry' show atx

如果我正确理解了您想要做的事情，这是不可能的。如果是，您可以很容易地构造一个类型为
Proxy t->Bool
的非常量函数

data NoShow = NoShow
data LiftedType = V1 | V2 | V3

type family (Show (Synonym (a :: LiftedType)) => Synonym (a :: LiftedType)) where
  Synonym V1 = Int
  Synonym V2 = NoShow -- no Show instance => compilation error
  Synonym V3 = ()

data YesNo = Yes | No
class Foo (yn :: YesNo) where foo :: Proxy yn -> Bool
type family (Foo (T t) => T t) where
    T X = Yes
    T y = No

f :: forall t. Proxy t -> Bool
f _ = foo (Proxy (T t))

但是你不能构造这样一个函数，即使所有涉及的类型都是封闭的（这当然是GHC的一个特性或限制，取决于你的观点）.
我也想要这个，但不幸的是，据我所知，这是不可能的。虽然我认为使用单例，但您只需要一个类。为什么不干脆
parseF:：forall lt.（Read（同义词lt），Show（同义词lt））=>SLiftedType lt->String->String
？据我所知，这足以满足您的需要。@AndrásKovács我为我的激励示例添加了一些进一步的上下文。
SLiftedType lt
的值事先不知道-我正在尝试将
（String，String）
解析为
（LiftedType，String）
，然后再解析为
（SLiftedType lt，同义词lt）
，但在
SomeSing
案例语句中隐藏依赖类型的部分。@bennofs-你只需要一个类是什么意思？@dbeacham我不认为这排除了我的建议。只要在
SomeSing slt
中对
slt
进行模式匹配，就可以处理那里不可显示/不可读的案例。我假设clo请您熟悉答案中的
singleton
。如果有不清楚的地方，请询问。