Traverse/Rewrite 一个 JSON 值

Question

我有以下 json-数据

value :: Maybe Value
value = decode
    "{ \"import\"  : { \"starttime\": \"2017-02-20T18:45:456.45645\" \
                   \ , \"endtime\"  : \"2017-02-20T18:45:456.45645\" \
                   \ } \
   \ , \"export\"  : { \"starttime\": \"2017-02-20T18:45:456.45645\" \
                   \ , \"endtime\"  : \"2017-02-20T18:45:456.45645\" \
                   \ } \
   \ , \"cleanup\" : { \"starttime\": \"2017-02-20T18:45:456.45645\" \
                   \ , \"endtime\"  : \"2017-02-20T18:45:456.45645\" \
                   \ , \"errormsg\" : \"It is dead Jim!\" \
                   \ } \
   \ }"

我的目标是重写这个对象，使其只包含给定键的 "direct path" - 例如如果我搜索 "errormsg" 它应该只是

Just "{\"cleanup\":\"It is dead Jim!\"}"

或

Just "{\"cleanup\": {\"errormsg\":\"It is dead Jim!\"}}"

和Nothing在密钥不存在的情况下，我对棱镜和遍历的知识仍处于发展阶段，所以我唯一能做的就是：

#!/usr/bin/env stack
-- stack runhaskell --package=lens --package=aeson --package=lens-aeson-lens --package=bytestring
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Lens
import Data.Aeson
import Data.Foldable
import Data.Aeson.Lens
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

value :: Maybe Value
value = decode
    "{ \"import\"  : { \"starttime\": \"2017-02-20T18:45:456.45645\" \
                   \ , \"endtime\"  : \"2017-02-20T18:45:456.45645\" \
                   \ } \
   \ , \"export\"  : { \"starttime\": \"2017-02-20T18:45:456.45645\" \
                   \ , \"endtime\"  : \"2017-02-20T18:45:456.45645\" \
                   \ } \
   \ , \"cleanup\" : { \"starttime\": \"2017-02-20T18:45:456.45645\" \
                   \ , \"endtime\"  : \"2017-02-20T18:45:456.45645\" \
                   \ , \"errormsg\" : \"It is dead Jim!\" \
                   \ } \
   \ }"

main :: IO ()
main = do
  traverse_ (traverse (B.putStrLn . encode))
            [ value & _Just . members %~ fromMaybe Null . preview (key "errormsg")
            , value & _Just . members %~ fromMaybe Null . preview (key "not here")
            ]

产生

{"export":null,"cleanup":"It is dead Jim!","import":null}
{"export":null,"cleanup":null,"import":null}

Answer 1

根据 Benjamin Hodgson 对路径使用单独数据类型的想法，这里有一个可能的解决方案，它使用 lens-aeson 和 Control.Lens.Plated:

import Control.Lens
import Control.Lens.Plated (para)
import Data.Foldable (asum)
import Data.Aeson
import qualified Data.Aeson.Lens
import Data.Text (Text)

data JsonPathPiece = Key Text | Index Int deriving Show

data JsonPath = JsonPath [JsonPathPiece] Value deriving Show

path :: Text -> Value -> Maybe JsonPath
path key = para go
    where
    go :: Value -> [Maybe JsonPath] -> Maybe JsonPath
    go v previous = case v of
        Object o  -> asum $ keyFound o : zipIntoMaybes Key o previous
        Array as  -> asum $ zipIntoMaybes Index as previous
        _         -> Nothing
    keyFound = preview (ix key.to (JsonPath [Key key]))
    zipIntoMaybes makePiece as mbs =
        zipWith fmap (toListOf (ifolded.asIndex.to makePiece.to addPiece) as) mbs
    addPiece piece (JsonPath pieces v) = JsonPath (piece:pieces) v

para 是 "destroys" 从叶子开始的 Value 的同构。在处理每个节点时，我们可以访问为其子节点获得的结果。

asum 对于 Maybereturns 从左数第一个 Just。

ifolded.asIndex 生成映射的键列表，或向量的整数索引列表。它们与当前节点的子节点的结果一对一匹配。

Traverse/Rewrite 一个 JSON 值

Traverse/Rewrite a JSON Value

haskell

haskell-lens