Выберите наиболее правильный экземпляр FromJSON с перекрывающимися определениями - PullRequest
Новая
       7

Выберите наиболее правильный экземпляр FromJSON с перекрывающимися определениями

0 голосов
/ 18 мая 2018

У меня есть необычный вариант использования для поддержки нескольких версий записи, которая передается через JSON и имеет большое количество значений Maybe.

data VersionedThing = V1 Thing1 | V2 Thing2 

data Thing1 = Thing { 
  name :: Maybe String,
  val1 :: Maybe String,
  val2 :: Maybe String,
}

data Thing2 = Thing { 
  name :: Maybe String,
  val3 :: Maybe String,
  val4 :: Maybe String,
} 

instance FromJSON Thing1 where 
  parseJSON (Object v) = Thing <$> v.: "name" <*> v.:? "val1" <*> v .:? "val2"

instance FromJSON Thing2 where 
  parseJSON (Object v) = Thing <$> v.: "name" <*> v.:? "val3" <*> v .:? "val4"

instance FromJSON (VersionedThing) where
  parseJSON v = (V1 <$> parseJSON v)
        `mplus` (V2 <$> parseJSON v)

Моя проблема заключается в том, что, поскольку эти записи совместно используют поле имени без каких-либо других требований, JSON, представляющий конкретную версию, всегда сможет быть проанализирован как другая версия.

Например, декодирование JSON 

{
  "name":"Foo",
  "val3":"Bar",
  "val4":"Baz"
}

Может привести к значениям haskell: 

Thing1 (Just "Foo") Nothing Nothing

или 

Thing2 (Just "Foo") (Just "Bar") (Just "Baz)

Есть ли способнаписать мой FromJSON экземпляр VersionedThing таким образом, чтобы он всегда анализировал, какое бы «самое правильное» значение, а не просто использовал первое для успеха?

1 Ответ

0 голосов
/ 18 мая 2018

Вот мой план: при разборе мы будем отслеживать, какие ключи мы просмотрели. Парсеры, которые не используют все ключи объекта, потерпят неудачу. Вот ваша преамбула, выделенная для полноты и компиляции: 

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad.Writer
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Functor.Compose
import Data.HashMap.Lazy (HashMap)
import Data.Text (Text)
import qualified Data.HashMap.Lazy as HM

data VersionedThing = V1 Thing1 | V2 Thing2 deriving (Eq, Ord, Read, Show)

data Thing1 = Thing1
    { name :: Maybe String
    , val1 :: Maybe String
    , val2 :: Maybe String
    } deriving (Eq, Ord, Read, Show)

data Thing2 = Thing2
    { name :: Maybe String
    , val3 :: Maybe String
    , val4 :: Maybe String
    } deriving (Eq, Ord, Read, Show)

Теперь мы добавим тип для разбора и отслеживания одновременно, а также встраивания для «просто разбора без отслеживания» и «просто отслеживания без разбора». 

type ParseAndTrack = Compose Parser (Writer (HashMap Text ()))

parse :: Parser a -> ParseAndTrack a
track :: Text -> ParseAndTrack ()

parse p = Compose (pure <$> p)
track t = Compose . pure . tell $ HM.singleton t ()

Мы можем использовать эти два примитива для поднятия (.:) и (.:?) к отслеживаемым версиям самих себя. Мы будем использовать суффикс & для вещей, которые анализируют и отслеживают. 

(.:&) :: FromJSON a => Object -> Text -> ParseAndTrack a
o .:& t = track t *> parse (o .: t)

(.:?&) :: FromJSON a => Object -> Text -> ParseAndTrack (Maybe a)
o .:?& t = (Just <$> (o .:& t)) <|> pure Nothing

Наконец, мы дадим высокоуровневый способ возврата из режима «разбора и отслеживания» в режим «только разбора», если произойдет сбой, если мы не использовали все доступные ключи. 

consumeAllOf :: Object -> ParseAndTrack a -> Parser a
consumeAllOf o p = do
    (result, keys) <- runWriter <$> getCompose p
    let unusedKeys = HM.difference o keys
    unless (null unusedKeys) . fail $
        "unrecognized keys " ++ show (HM.keys unusedKeys)
    return result

Теперь мы можем написать два ваших синтаксических анализатора с помощью вышеперечисленных дополнительных инструментов, и все должно просто работать. Единственная разница в синтаксических анализаторах для Thing1 и Thing2 заключается в том, что мы добавляем consumeAllOf впереди и используем отслеживающие версии .: и .:? в середине. 

instance FromJSON Thing1 where
    parseJSON (Object v) = consumeAllOf v $ Thing1 <$> v.:& "name" <*> v.:?& "val1" <*> v .:?& "val2"

instance FromJSON Thing2 where
    parseJSON (Object v) = consumeAllOf v $ Thing2 <$> v.:& "name" <*> v.:?& "val3" <*> v .:?& "val4"

instance FromJSON (VersionedThing) where
    parseJSON v = (V1 <$> parseJSON v)
          `mplus` (V2 <$> parseJSON v)

Попробуйте в ghci: 

> decode "{\"name\": \"foo\", \"val1\": \"bar\"}" :: Maybe VersionedThing
Just (V1 (Thing1 {name = Just "foo", val1 = Just "bar", val2 = Nothing}))
> decode "{\"name\": \"foo\", \"val3\": \"bar\"}" :: Maybe VersionedThing
Just (V2 (Thing2 {name = Just "foo", val3 = Just "bar", val4 = Nothing}))
...