Singletones, type families, and existential types for an FromJSON instance

Question

It is probably easier to first outline my general problem, and then show where I am stuck.

I want to get a JSON list with an index of type singleton, where the index type also has a sibling type family. In code:

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)

With existential quantification, I have to be able to hide the variable index and still be able to get the values ​​(with some function like an earlier ranking with continuation), there might be a better name for that). I would end up with my program running along the lines

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

where Someis from the package exinst, but is also redefined below. I can parse JSON if I do not parse MyFamily mt, but I cannot find a better way to enable parsing from 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), typechecker mt ~ mt0, , ).

, ?

, (, ..). , , , ( ) .

Answer 1

( ).

, , , 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"

, -, . , .

singleton, "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. . defunctionalization singletons.

, : . ForallInst , , .

Answer 2

, :

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

. , .

, , , " MyType ". , ( " " " n" ) GHC ( , , , , .)

, , , FromJSON (MyFamily mt).

, , , . ( , .) , GADT? :.

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

, MyCompoundType .