FromJSON 实例的单例、类型族和存在类型

Question

首先简要概述我的一般问题，然后显示我遇到的问题可能更容易。

我想接收一些单例索引类型的 JSON 列表，其中索引类型也有关联的类型族。在代码中：

data MyType = MyValue1 | MyValue2
type family MyFamily (mt :: MyType) where
    MyFamily MyValue1 = Int
    MyFamily MyValue2 = Double
data InputType (mt :: MyType) = InputNoFamily | InputWithFamily (MyFamily mt)
data OutputType (mt :: MyType) = OutputNoFamily | OutputWithFamily (MyFamily mt)

通过存在量化，我应该能够隐藏变化的索引，并且仍然能够获得值（使用一些类似连续性的高级类型函数 - 可能有更好的名称）。我最终会按照

的方式运行我的程序

JSON -> [Some InputType] -> [Some OutputType] -> JSON

其中 Some 来自 exinst 包，但也在下面重新定义。我可以在不解析 MyFamily mt 的情况下解析 JSON，但我也无法找到从 JSON 解析它的最佳方法。

我目前的情况如下：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RankNTypes #-}

module SO where

import Data.Aeson
import Data.Singletons.TH
import GHC.Generics

$(singletons [d|
  data MyType
    = MyValue1
    | MyValue2
    | MyValue3
    deriving (Show, Eq, Generic)
  |])
instance FromJSON MyType

type family MyFamily (mt :: MyType) :: * where
  MyFamily 'MyValue1 = Double
  MyFamily 'MyValue2 = Double
  MyFamily 'MyValue3 = Int

-- stolen from exinst package
data Some (f :: k -> *) =
    forall a. Some (Sing a) (f a)

some :: forall (f :: k -> *) a. SingI a => f a -> Some f
some = Some (sing :: Sing a)

withSome :: forall (f :: k -> *) (r :: *). Some f -> (forall a. SingI a => f a -> r) -> r
withSome (Some s x) g = withSingI s (g x)

data MyCompoundType (mt :: MyType)
    = CompoundNoIndex
    | CompoundWithIndex (MyFamily mt)

deriving instance (Show (SMyType mt), Show (MyFamily mt)) => Show (MyCompoundType mt)

-- instance with no parsing of `MyFamily`
instance
  forall (mt :: MyType).
  ( SingKind (KindOf mt)
  , FromJSON (DemoteRep (KindOf mt))
  ) => FromJSON (Some MyCompoundType) where
    parseJSON = withObject "MyCompoundType" $ \o -> do
      mt :: MyType <- o .: "myType"
      case toSing mt of
        SomeSing (smt :: SMyType mt') -> case smt of
          SMyValue1 -> return $ some (CompoundNoIndex :: MyCompoundType mt')
          SMyValue2 -> return $ some (CompoundNoIndex :: MyCompoundType mt')
          SMyValue3 -> return $ some (CompoundNoIndex :: MyCompoundType mt')

我显然需要添加一个 FromJSON (MarketIndex mt) 约束，但我还需要能够将它绑定到我为其生成实例的 Some CompoundType。

简单添加一个FromJSON (MyFamily mt) containt

instance
  forall (mt :: MyType).
  ( SingKind (KindOf mt)
  , FromJSON (DemoteRep (KindOf mt))
  , FromJSON (MyFamily mt)
  ) => FromJSON (Some MyCompoundType) where
    parseJSON = undefined

给出类型不明确的错误

Could not deduce (FromJSON (MyFamily mt0))
  arising from the ambiguity check for an instance declaration
from the context (SingKind (KindOf mt),
                  FromJSON (DemoteRep (KindOf mt)),
                  FromJSON (MyFamily mt))
  bound by an instance declaration:
             (SingKind (KindOf mt), FromJSON (DemoteRep (KindOf mt)),
              FromJSON (MyFamily mt)) =>
             FromJSON (Some MyCompoundType)
  at SO.hs:(57,3)-(61,39)
The type variable ‘mt0’ is ambiguous
In the ambiguity check for:
  forall (mt :: MyType).
  (SingKind (KindOf mt), FromJSON (DemoteRep (KindOf mt)),
   FromJSON (MyFamily mt)) =>
  FromJSON (Some MyCompoundType)
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
In the instance declaration for ‘FromJSON (Some (MyCompoundType))’

我可以看到类型检查器谈论 mt0 而不是 mt 是一个大问题，但我不知道如何哄骗它来期待 mt 类型约束的右侧。

（我也意识到我没有包含 FromJSON (MyFamily mt) 个实例，但如果类型检查器无法弄清楚 mt ~ mt0 我认为目前不重要）。

希望有解决办法？

我花了相当多的时间来尝试不同的事情，但有很多不同的事情正在发生（单身人士、存在主义者等）。我正在慢慢让自己达到一定程度的熟练程度，但我只是没有足够的知识或经验来确定它们是如何（或没有）导致问题的。

Answer 1

我对单例不是很熟悉，但我还是发现了一个可能的误解：

在您当前的实例中，部分

forall (mt :: MyType).
  ( SingKind (KindOf mt)
  , FromJSON (DemoteRep (KindOf mt))
  ) =>

根本没用过。如果您删除该文件，它也能正常编译。

在我看来，您似乎在尝试设置一个约束条件，表示 "For all types of kind MyType, these instances should exist." 不幸的是，目前不支持这样的功能（有时称为 "quantified constraints" 或 "rank n constraints"） GHC（和 Simon PJ，他是第一个提出它的论文的合著者，他公开表示他不知道如何为它实现类型推断。）

我假设您的修改版本不起作用的原因是您实际上确实需要 FromJSON (MyFamily mt) 部分的量化约束。

不过，我有一种预感，希望对您有所帮助。（不幸的是，我对使用单例来编写实际的解决方案尝试了解不够。）如果您将某些类型替换为 GADT 会怎样？例如：

data MyCompoundType (mt :: MyType) where
    CompoundNoIndex :: MyCompoundType mt
    CompoundWithIndex :: FromJSON (MyFamily mt) => MyCompoundType mt

这样，MyCompoundType 就可以随身携带所需的实例。

Answer 2

（我之前对你的的回答在很大程度上适用于此）。

您可以自由地解析任何您想要的类型，您只需要证明特定类型有一个 FromJSON 实例。在这种情况下，您应该解析 MyFamily 的具体结果类型，因为它们都有适当的实例。

instance FromJSON (Some MyCompoundType) where
    parseJSON = withObject "MyCompoundType" $ \o -> do
      cons :: String <- o .: "constructor"
      mt :: MyType <- o .: "myType"
      case toSing mt of
        SomeSing smt ->
          case cons of
            "CompoundNoIndex" -> pure $ Some smt CompoundNoIndex
            "CompoundWithIndex" -> case smt of
              SMyValue1 -> Some SMyValue1 . CompoundWithIndex <$> o .: "field"
              SMyValue2 -> Some SMyValue2 . CompoundWithIndex <$> o .: "field"
              SMyValue3 -> Some SMyValue3 . CompoundWithIndex <$> o .: "field"

这里我假设有一些东西表示编码构造函数。当然，有许多可供选择的编码和解码格式。

或者，我们可以将量化约束的近似值放在一起，并更多地使用从 "myType" 字段解析的单例标记：

import Data.Constraint -- from "constraints"
import Data.Proxy

data MyFamilySym :: TyFun MyType * -> *
type instance Apply MyFamilySym a = MyFamily a  

class ForallInst (f :: TyFun k * -> *) (c :: * -> Constraint) where
  allInst :: Proxy '(f, c) -> Sing x -> Dict (c (f @@ x))

instance ForallInst MyFamilySym FromJSON where
  allInst _ SMyValue1 = Dict
  allInst _ SMyValue2 = Dict
  allInst _ SMyValue3 = Dict  

instance FromJSON (Some MyCompoundType) where
    parseJSON = withObject "MyCompoundType" $ \o -> do
      cons :: String <- o .: "constructor"
      SomeSing smt <- toSing <$> o .: "myType"
      case cons of
        "CompoundNoIndex" -> pure (Some smt CompoundNoIndex)
        "CompoundWithIndex" ->
          case allInst (Proxy :: Proxy '(MyFamilySym, FromJSON)) smt of
            Dict -> Some smt . CompoundWithIndex <$> o .: "field"

这里的关键点是 MyFamilySym 和 Apply 的去功能化。它使我们能够有效地将 MyFamily 放入实例头中，否则这将被 GHC 禁止。有关 singletons 中去功能化的更多信息，请参阅此 blog post。

对于类型族上的量化实例，我们永远无法避免一件事：写出类型族的所有情况并为每个情况演示一个实例。 ForallInst 解决方案也这样做，但至少它要求我们只写一次案例。

FromJSON 实例的单例、类型族和存在类型

Singletons, type families, and existential types for a FromJSON instance

haskell

existential-type

typeclass

data-kinds