如何在具有自定义类型类约束的GADT上实现fromJSON?

时间:2019-01-27 21:48:25

标签: haskell typeclass aeson gadt

我有以下GADT:

{-# LANGUAGE GADTs #-}

data LogProtocol a where
  Message :: String -> LogProtocol String
  StartRun :: forall rc. (Show rc, Eq rc, Titled rc, ToJSON rc, FromJSON rc) 
   => rc -> LogProtocol rc
  ... and many more...

toJSON很简单,没有显示。 fromJSON的实现基于:

This SO Question和   This Blog Post - pattern 2

如下:

{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

-- tag type is used in to/ from JSON to reduce the use of magic strings
data LPTag = MessageT |
             StartRunT |
             ... and many more...
             deriving (Show, Eq, Enum)

tagList :: Enum a => [a]
tagList = enumFrom $ toEnum 0

$(deriveJSON defaultOptions ''LPTag) 

-- a wrapper to hide the a type param in the GADT
data Some (t :: k -> *) where
  Some :: t x -> Some t

instance FromJSON (Some LogProtocol) where

parseJSON :: Value -> Parser (Some LogProtocol)
parseJSON v@(Object o) =
  let 
    tag :: Maybe LPTag 
    tag = do 
      t <- (HML.lookup "type" o) 
      parseMaybe parseJSON t 

    failMessage :: [Char]
    failMessage = toS $ "Could not parse LogProtocol no type field or type field value is not a member of specified in: " 
                    <> (show(tagList :: [LPTag])) 
                    <> show v

  in 
    maybe  
      (fail failMessage )
      (
        \case 
          MessageT -> Some <$> (Message <$> o .: "txt")    
          StartRunT -> Some <$> (StartRun <$> o .: "runConfig")
      )
      tag        

parseJSON wrng = typeMismatch "LogProtocol" wrng

'''Message'''的情况很好。我遇到的问题是诸如以下的错误:

* No instance for (Titled x2) arising from a use of `StartRun'
* In the first argument of `(<$>)', namely `StartRun'
  In the second argument of `(<$>)', namely
    `(StartRun <$> o .: "runConfig")'
  In the expression: Some <$> (StartRun <$> o .: "runConfig")

我在任何地方都有自己的类型类约束(例如“标题”) 在数据构造函数中,编译器说“否”。 有办法解决这个问题吗?

1 个答案:

答案 0 :(得分:3)

现有类型是反模式,尤其是在需要反序列化的情况下。 StartRun应该改为包含一个具体类型。反序列化仍然需要一种具体的类型,因此您也可以将StartRun专门化。