Как анализировать значения, распределенные по массиву, с помощью Aeson?

Помощники withXXX делают все немного неуклюжим, но вот.

Тип Aeson Parser назван неправильно, и это вызывает путаницу. Идея с объектами Aeson Parser заключается в том, что они представляют монадический результат синтаксического анализа. (Это отличается от объектов Parser, которые вы найдете в Parsec и т. д., которые представляют настоящие монадические синтаксические анализаторы.) Таким образом, вы должны думать о Parser a как об изоморфном Either ParseError a — монадическом результате с возможностью ошибки.

Эти результаты синтаксического анализа обычно объединяются аппликативно. Итак, если у вас есть парсер, например:

data Xyz = Xyz { x :: String, y :: String }
instance FromJSON Xyz where
  parseJSON = withObject "Xyz" $ \v ->
    Xyz <$> v .: "x" <*> v .: "y"

результаты синтаксического анализа v .: "x" и v .: "y" имеют тип Parser String, который действительно похож на Either ParseError a, а последняя строка этого экземпляра представляет собой обычный метод объединения успешных и неудачных результатов в аппликативной манере, в соответствии со строками:

Xyz <$> Right "value_x" <*> Left "while parsing Xyz: key y was missing"

Теперь функция parseJSON имеет тип Value -> Parser a. Это то, что правильно называть парсером, но во избежание путаницы давайте назовем это функцией разбора. Функция синтаксического анализа принимает представление JSON (Value, или Object, или что-то еще в формате JSON) и возвращает результат синтаксического анализа. Семейство функций withXXX используется для адаптации функций синтаксического анализа между штуковинами JSON. Если у вас есть функция синтаксического анализа, которая ожидает Object, например:

\v -> Xyz <$> v .: "x" <*> v .: "y"   :: Object -> Parser Xyz

и вы хотите адаптировать его к parseJSON :: Value -> Parser Xyz, вы используете для этого withObject "str" :: (Object -> Parser Xyz) -> (Value -> Parser Xyz).

Возвращаясь к вашей проблеме, если вы хотите написать основной синтаксический анализатор, который выглядит так:

\v -> Abc <$> v .: "name" <*> extra .:? "this_string_A"
                          <*> extra .:? "this_string_B"

вы хотите, чтобы extra было Object, и вы хотите извлечь его монадически из общего объекта JSON v :: Object, используя соответствующие помощники withXXX для адаптации функций разбора от одного входного типа JSON к другому. Итак, давайте напишем монадическую функцию (фактически функцию синтаксического анализа), чтобы сделать это:

getExtra :: Object -> Parser Object
getExtra v = do

Во-первых, мы монадически извлекаем необязательный дополнительный компонент из v. Здесь мы используем условную форму, поэтому mextra :: Maybe Value.

  mextra <- v .:? "extra"

Во-вторых, давайте монадически создадим наш окончательный Object из mextra. Это будет JSON Object с ключами "this_string_A" и "this_string_B" с удаленным слоем массива. Обратите внимание, что тип этого выражения case будет Parser Object, результат синтаксического анализа имеет тип Object = HashMap key value. Для случая Just у нас есть Value, который, как мы ожидаем, будет массивом, поэтому давайте воспользуемся помощником withArray, чтобы убедиться в этом. Обратите внимание, что вспомогательная функция withArray "str" берет нашу функцию синтаксического анализа типа \arr -> do ... :: Array -> Parser Object и адаптирует ее к Value -> Parser Object, чтобы ее можно было применить к vv :: Value.

  case mextra of
    Just vv -> vv & withArray "Abc.extra" (\arr -> do

Теперь arr это Array = Vector Value. Мы надеемся, что это массив из Objects. Давайте вытащим Value в виде списка:

      let vallst = toList arr

а затем монадически пройтись по списку с помощью withObject, чтобы убедиться, что все они Object, как и ожидалось. Обратите внимание на использование здесь pure, поскольку мы хотим извлечь Object как есть без какой-либо дополнительной обработки:

      objlst <- traverse (withObject "Abc.extra[..]" pure) vallst

Теперь у нас есть objlst :: [Object]. Это набор одноэлементных хэш-карт с непересекающимися ключами, и Object / хэш-карта, которую мы хотим, является их объединением, поэтому давайте вернем это. Скобка здесь заканчивает выражение withArray, которое применяется к vv:

      return $ HashMap.unions objlst)

Для случая Nothing (лишнее не найдено) мы просто возвращаем пустую хэш-карту:

    Nothing -> return HashMap.empty

Полная функция выглядит так:

getExtra :: Object -> Parser Object
getExtra v = do
  mextra <- v .:? "extra"
  case mextra of
    Just vv -> vv & withArray "Abc.extra" (\arr -> do
      let vallst = toList arr
      objlst <- traverse (withObject "Abc.extra[..]" pure) vallst
      return $ HashMap.unions objlst)
    Nothing -> return HashMap.empty

и вы используете его в своем экземпляре парсера следующим образом:

instance FromJSON Abc where
  parseJSON =
   withObject "Abc" $ \v -> do
    extra <- getExtra v
    Abc <$> v .: "name" <*> extra .:? "this_string_A" <*> extra .:? "this_string_B"

С тестовым случаем:

example :: BL.ByteString
example = "{\"name\": \"xyz1\", \"extra\": [{\"this_string_A\": \"Hello\"}, {\"this_string_B\": \"World\"}]}"

main = print (eitherDecode example :: Either String Abc)

это работает так:

λ> main
Right (Abc {name = "xyz1", a = Just "Hello", b = Just "World"})

Полный код:

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

import Data.Aeson (eitherDecode, FromJSON, Object, parseJSON, withArray, withObject, (.:), (.:?))
import Data.Aeson.Types (Parser)
import GHC.Generics (Generic)
import qualified Data.ByteString.Lazy as BL (ByteString)
import qualified Data.HashMap.Strict as HashMap (empty, unions)
import Data.Function ((&))
import Data.Foldable (toList)

data Abc = Abc
  { name :: String
  , a :: Maybe String
  , b :: Maybe String
  } deriving (Generic, Show)

instance FromJSON Abc where
  parseJSON =
   withObject "Abc" $ \v -> do
    extra <- getExtra v
    Abc <$> v .: "name" <*> extra .:? "this_string_A" <*> extra .:? "this_string_B"

getExtra :: Object -> Parser Object
getExtra v = do
  mextra <- v .:? "extra"
  case mextra of
    Just vv -> vv & withArray "Abc.extra" (\arr -> do
      let vallst = toList arr
      objlst <- traverse (withObject "Abc.extra[..]" pure) vallst
      return $ HashMap.unions objlst)
    Nothing -> return HashMap.empty

example :: BL.ByteString
example = "{\"name\": \"xyz1\", \"extra\": [{\"this_string_A\": \"Hello\"}, {\"this_string_B\": \"World\"}]}"

main = print (eitherDecode example :: Either String Abc)

Частичный ответ...

instance FromJSON Abc where
     parseJSON = withObject "Abc" $ \v -> Abc
         <$> v .: "name"
         <*> (v .: "extra" >>= myParse)
         <*> (v .: "extra" >>= myParse)


myParse :: Array -> Parser (Maybe String)
myParse x = withArray "extra" (lookupDictArray "this_string_a") (Array x)

lookupDictArray :: Text -> Array -> Parser (Maybe String)
lookupDictArray k a = do
  let v = Vector.find (maybe False (HashMap.member k) . parseMaybe parseJSON) a
  case v of
    Just v' -> withObject "grrrrrrrrrrr" (\v -> v .: k) v'
    Nothing -> pure Nothing

Не удается проверить тип с помощью:

src/Example.hs:32:69-77: error:
    • Ambiguous type variable ‘a0’ arising from a use of 
‘parseJSON’
      prevents the constraint ‘(FromJSON a0)’ from being 
solved.
      Probable fix: use a type annotation to specify 
what ‘a0’ should be.
      These potential instances exist:
        instance FromJSON DotNetTime
          -- Defined in ‘aeson-1.4.4.0:Data.Aeson.Types.FromJSON’
        instance FromJSON Value
          -- Defined in ‘aeson-1.4.4.0:Data.Aeson.Types.FromJSON’
        instance (FromJSON a, FromJSON b) => FromJSON 
(Either a b)
          -- Defined in ‘aeson-1.4.4.0:Data.Aeson.Types.FromJSON’
        ...plus 29 others
        ...plus 60 instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the first argument of ‘parseMaybe’, namely 
‘parseJSON’
      In the second argument of ‘(.)’, namely 
‘parseMaybe parseJSON’
      In the first argument of ‘Vector.find’, namely
        ‘(maybe False (member k) . parseMaybe 
parseJSON)’
   |
32 |   let v = (Vector.find (maybe False (HashMap.member 
k) . parseMaybe parseJSON) a)