Traverse/Rewrite a JSON Value

Question

I have the following json-data

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!\" \
                   \ } \
   \ }"

and my goal would be to rewrite this object such that it only contains the "direct path" to a given key - e.g. if I search for "errormsg" it should only be

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

or

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

and Nothing in the case where the key is not present, my knowledge about Prisms and Traversals is still in the stage of development so the only thing I managed to do is:

#!/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")
            ]

which yields

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

Answer 1

Following Benjamin Hodgson's idea of having a separate data type for paths, here's a possible solution which uses lens-aeson and 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 is a paramorphism that "destroys" a Value starting form the leaves. When processing each node, we have access to the results obtained for its children.

asum for Maybereturns the first Just from the left.

ifolded.asIndex produces the list of keys of a map, or the list of integer indices for a vector. They are matched one for one with the results for the children of the current node.