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

时间:2015-10-08 16:43:51

标签: haskell typeclass existential-type data-kinds

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

我想收到一些单独索引类型的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) constaint

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))’

我可以看到typechecker谈论mt0而不是mt是一个大问题,但我不知道如何将其哄骗到右边的mt类型中手边的约束。

(我也意识到我没有包含FromJSON (MyFamily mt)个实例,但是如果类型检查器无法找出mt ~ mt0我认为当前不重要。

希望有一个解决办法吗?

我花了相当多的时间尝试不同的事情但是有很多不同的事情发生(单身,存在等)。我正逐渐达到某种程度的熟练程度,但我没有足够的知识或经验来确定他们是否(或没有)为这个问题做出贡献。

2 个答案:

答案 0 :(得分:2)

我对单身人士并不熟悉,但我仍然发现可能存在误解:

在您当前的实例中,部分

forall (mt :: MyType).
  ( SingKind (KindOf mt)
  , FromJSON (DemoteRep (KindOf mt))
  ) =>
完全没有使用

。如果你删除它,文件也会编译。

在我看来,你正试图有一个约束,说明&#34;对于所有类型MyType,这些实例应该存在。&#34;不幸的是,GHC目前不支持这样的功能(有时称为&#34;量化约束&#34;或#34;排名n约束&#34;)和Simon PJ,他是首次提出它的论文的共同作者有记录表示他不知道如何实现类型推断。)

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

我有预感,我希望可能有所帮助。 (遗憾的是,我不太了解使用单身人士编写实际的解决方案尝试。)如果用GADT替换某些类型怎么办? e.g:

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

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

答案 1 :(得分:2)

(我之前对您prior question的回答在很大程度上适用于此处。)

您可以自由地解析您想要的任何类型,您只需要证明特定类型具有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" 

这里的关键点是MyFamilySymApply的功能化。它使我们能够有效地将MyFamily置于实例头中,否则GHC将禁止这样做。有关singletons中的去功能化的更多信息,请参阅此blog post

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