使用 Aeson 解析 JSON 文档时解析引用

Resolving references while parsing a JSON document with Aeson

我有一个 JSON 文档,如下所示:

{  
   "persons":[  
      {  "id":"343", "name":"John", "age":"45" }
   ],
   "houses":[  
      {  "owner_id":"343" "address":"Charing Cross" }
   ]
}

和 Haskell 数据类型如下:

data City = City { persons :: [Person], houses :: [Houses] }

data Person = Person { personId :: Text, name :: Text }

data House = House { owner :: Person, address :: Text }

在解析 Aeson 的 Value 对象时,我想解析 houses 中的 owner_id 引用,并将它们变成完整的 Person 值。

通常我使用 (.:) 等不错的运算符构建 Aeson 解析器,但解析引用的需要似乎使这里的事情复杂化。

有没有一种方法可以定义一个 Parser City 实现,而不是在 JSON 对象的底层 HashMap 中查找键?

这项不平凡的任务提供了展示替代方案 "aeson-value-parser" library 的强大功能和灵活性的绝好机会,它提供了基于典型 Monadic/Applicative 解析器的 DSL。

输出如下:

Right (City {cityPersons = [Person {personId = "343", personName = "John"}], cityHouses = [House {houseOwner = Person {personId = "343", personName = "John"}, houseAddress = "Charing Cross"}]})

是以下程序产生的结果:

{-# LANGUAGE NoImplicitPrelude #-}

-- A richer prelude from "rebase"
import Rebase.Prelude
-- The parser API from "aeson-value-parser"
import Aeson.ValueParser
-- A reexport of the original API of "unordered-containers" from "rebase"
import qualified Rebase.Data.HashMap.Strict
-- From "aeson"
import qualified Data.Aeson


main =
  print $
  run city $
  fromJust $
  Data.Aeson.decode $
  "{\"persons\":[{\"id\":\"343\",\"name\":\"John\",\"age\":\"45\"}],\"houses\":[{\"owner_id\":\"343\",\"address\":\"Charing Cross\"}]}"


-- * Model
-------------------------

data City =
  City { cityPersons :: [Person], cityHouses :: [House] }
  deriving (Show)

data Person =
  Person { personId :: Text, personName :: Text }
  deriving (Show)

data House =
  House { houseOwner :: Person, houseAddress :: Text }
  deriving (Show)


-- * Parsers
-------------------------

city :: Value City
city =
  object $ do
    theTable <- field "persons" personsLookupTable
    theHouses <- field "houses" (houses theTable)
    return (City (Rebase.Data.HashMap.Strict.elems theTable) theHouses)

-- |
-- >[  
-- >  { "id":"343", "name":"John", "age":"45" }
-- >]
personsLookupTable :: Value (HashMap Text Person)
personsLookupTable =
  array $
  foldlElements step init personsLookupTableRow
  where
    init =
      Rebase.Data.HashMap.Strict.empty
    step table (key, person) =
      Rebase.Data.HashMap.Strict.insert key person table

-- |
-- >{ "id":"343", "name":"John", "age":"45" }
personsLookupTableRow :: Value (Text, Person)
personsLookupTableRow =
  object $
  (\id name -> (id, Person id name)) <$> id <*> name
  where
    id =
      field "id" string
    name =
      field "name" string

-- |
-- >[  
-- >  { "owner_id":"343" "address":"Charing Cross" }
-- >]
houses :: HashMap Text Person -> Value [House]
houses personsLookupTable =
  array $
  foldrElements (:) [] (house personsLookupTable)

-- |
-- Parses the \"house\" object, using a 'Person' lookup table. 
-- E.g.,
-- >{ "owner_id":"343" "address":"Charing Cross" }
house :: HashMap Text Person -> Value House
house personsLookupTable =
  object $
  House <$> owner <*> address
  where
    owner =
      field "owner_id" (personByID personsLookupTable)
    address =
      field "address" string

-- |
-- Given an ID-lookup table consumes the ID and produces the lookup result.
-- Fails if any of those operations fail.
personByID :: HashMap Text Person -> Value Person
personByID lookupTable =
  string >>= lookup
  where
    lookup key =
      maybe mzero return $
      Rebase.Data.HashMap.Strict.lookup key lookupTable