Как я могу реализовать из JSON в GADT с пользовательскими ограничениями классов типов? - PullRequest
Новая
       37

Как я могу реализовать из JSON в GADT с пользовательскими ограничениями классов типов?

0 голосов
/ 28 января 2019

У меня есть следующий 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 основана на:

Этот вопрос SO и Этот пост блога - образец 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")

Везде, где у меня есть свои собственные ограничения класса типов (например, Titled) в конструкторе данных, компилятор говорит «Нет».Есть ли способ решить эту проблему?

1 Ответ

0 голосов
/ 28 января 2019

Экзистенциальные типы являются антипаттернами, особенно если вам необходимо выполнить десериализацию.Вместо этого StartRun должен содержать конкретный тип.В любом случае для десериализации требуется конкретный тип, поэтому вы можете также специализировать StartRun для него.

...