Search code examples
haskelltypeclassaesongadt

How can I implement fromJSON on a GADT with custom type class constraints?


I have the following 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 is straight forward and not shown. fromJSON implementation is based on:

This SO Question and This Blog Post - pattern 2

and is as follows:

{-# 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

The case for '''Message''' is fine. The problem I am having are errors such as:

* 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")

Anywhere I have my own type class constraints (such as Titled) in the data constructor the compiler says "No". Is there a way to resolve this?


Solution

  • Existential types are an antipattern, especially if you need to do deserialization. StartRun should contain a concrete type instead. Deserialization requires a concrete type anyway, hence you might as well specialize StartRun to it.