haskell - 在 aeson 的解析器中收集对象的所有未使用字段的更好方法？

Question

假设我要实现 FromJSON对于数据类型。以下是完整的源代码:

{-# LANGUAGE
    NamedFieldPuns
  , OverloadedStrings
  , TupleSections
  , ViewPatterns
  #-}
module Main
  ( main
  ) where

import Data.Aeson
import Control.Monad

import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as M
import qualified Data.Text as T

data Foo
  = Foo
  { aaa :: Int
  , bbb :: T.Text
  , ccc :: Maybe (Int, Int)
  , extra :: M.Map T.Text T.Text
  }

instance FromJSON Foo where
  parseJSON = withObject "Foo" $ \obj -> do
    aaa <- obj .: "aaa"
    bbb <- obj .: "bbb"
    ccc <- obj .:? "ccc"
    let existingFields = T.words "aaa bbb ccc"
        obj' =
          -- for sake of simplicity, I'm not using the most efficient approach.
          filter ((`notElem` existingFields) . fst)
          . HM.toList
          $ obj
    (M.fromList -> extra) <- forM obj' $ \(k,v) ->
      withText "ExtraText" (pure . (k,)) v
    pure Foo {aaa,bbb,ccc,extra}

main :: IO ()
main = pure ()

此数据类型 Foo有一堆可能不同类型的字段，最后有 extra收集所有剩余的字段。

显然没有人会喜欢更新 existingFields每次添加/删除/更新某些字段时，有什么推荐的方法来收集未使用的字段？

我能想到的另一种方法是堆叠 StateT上面有 obj (转换为 Map )作为初始状态，并使用类似 Data.Map.splitLookup 的内容“排放”使用过的领域。但是我不愿意这样做，因为它会涉及到一些提升 monad 堆栈的操作，而且从 Map 中一次删除一个元素在性能方面听起来不是很好。与通过 HashMap 过滤相比一通到底。

Answer 1

no one would enjoy updating existingFields every time some fields get add/remove/update-ed

考虑这个函数

import Data.Aeson.Types (Parser)
import Data.Text (Text)
import Control.Monad.Trans.Writer
import Data.Functor.Compose

keepName :: (Object -> Text -> Parser x) 
         ->  Object -> Text -> Compose (Writer [Text]) Parser x
keepName f obj fieldName = Compose $ do
    tell [fieldName]
    pure (f obj fieldName)

它将像 .: 这样的运算符作为输入。或 .:? 并“丰富”它的结果值，而不是返回 Parser ，它返回一个 Parser 嵌套在 Writer 中用于累积提供的字段名称。作品被包裹在 Compose newtype，它会自动给我们一个 Applicative例如因为，如文档中所述:

(Applicative f, Applicative g) => Applicative (Compose f g)

(尽管该组合不是 Monad。还要注意我们使用的是 Writer 而不是 WriterT 。我们是 nesting Applicative s ，没有应用单子(monad)更改器(mutator))。

其余代码没有太大变化:

{-# LANGUAGE ApplicativeDo #-}

instance FromJSON Foo where
  parseJSON = withObject "Foo" $ \obj -> do
    let Compose (runWriter -> (parser,existingFields)) = 
            do aaa <- keepName (.:) obj "aaa"
               bbb <- keepName (.:) obj "bbb"
               ccc <- keepName (.:?) obj "ccc"
               pure Foo {aaa,bbb,ccc,extra = mempty}            
        obj' =
            filter ((`notElem` existingFields) . fst)
            . HM.toList
            $ obj
    (M.fromList -> extra) <- forM obj' $ \(k,v) ->
      withText "ExtraText" (pure . (k,)) v
    r <- parser
    pure $ r { extra }