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

Better ways to collect all unused field of an Object in aeson's Parser?

假设我想为数据类型实现 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 收集所有剩余的字段。

显然没有人会喜欢在每次某些字段 add/remove/update-ed 时更新 existingFields,有什么推荐的收集未使用字段的方法吗?

我能想到的另一种方法是在顶部堆叠一个 StateT,并将 obj(转换为 Map)作为初始状态,并使用类似 Data.Map.splitLookup 到 "discharge" 使用的字段。但我不愿意这样做,因为它会涉及一些围绕 monad 堆栈的提升,并且与通过 HashMap 过滤相比,从 Map 中一次删除一个元素听起来不是很好的性能一关到底。

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)

它将像 .: or .:? and "enriches" its result value so that, instead of returning a Parser, it returns a Parser nested inside a Writer that serves to accumulate the supplied field names. The composition is wrapped in the Compose newtype 这样的运算符作为输入,它会自动为我们提供一个 Applicative 实例,因为如文档中所述:

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

(尽管组合不是 Monad。另请注意,我们使用的是 Writer 而不是 WriterT。我们是 nesting Applicatives,未应用 monad 转换器).

其余代码没有太大变化:

{-# 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 }