module Data.Aeson.Lens (
nth,
key,
traverseArray,
traverseObject,
) where
import Control.Applicative
import Control.Lens
import Data.Aeson
import qualified Data.HashMap.Strict as HMS
import Data.List.Lens
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Vector as V
data ValueIx = ArrIx Int | ObjIx T.Text
valueAt :: (ToJSON v, FromJSON v)
=> ValueIx
-> SimpleIndexedLens ValueIx (Maybe Value) (Maybe v)
valueAt k = index $ \f (fmap toJSON -> v) -> go k v <$> f k (lu k v) where
go (ObjIx ix) (Just (Object o)) Nothing = Just $ Object $ HMS.delete ix o
go (ObjIx ix) (Just (Object o)) (Just v) = Just $ Object $ HMS.insert ix (toJSON v) o
go (ObjIx ix) _ (Just v) = Just $ Object $ HMS.fromList [(ix, toJSON v)]
go (ArrIx ix) (Just (Array a)) Nothing = Just $ Array $ updateV ix Null a
go (ArrIx ix) (Just (Array a)) (Just v) = Just $ Array $ updateV ix (toJSON v) a
go (ArrIx ix) _ (Just v) = Just $ Array $ updateV ix (toJSON v) mempty
go _ v _ = v
lu (ObjIx ix) (Just (Object o)) = fromJSONMaybe =<< HMS.lookup ix o
lu (ArrIx ix) (Just (Array a)) | ix >= 0 && ix < V.length a = fromJSONMaybe $ a V.! ix
lu _ _ = Nothing
updateV :: Int -> Value -> V.Vector Value -> V.Vector Value
updateV i v a
| i >= V.length a =
updateV i v $ V.generate (i + 1) $ \ii -> fromMaybe Null $ a `V.indexM` ii
| otherwise =
a V.// [(i, v)]
fromJSONMaybe :: FromJSON a => Value -> Maybe a
fromJSONMaybe v = case fromJSON v of
Error _ -> Nothing
Success a -> Just a
nth :: (ToJSON v, FromJSON v)
=> Int
-> SimpleIndexedLens ValueIx (Maybe Value) (Maybe v)
nth = valueAt . ArrIx
key :: (ToJSON v, FromJSON v)
=> T.Text
-> SimpleIndexedLens ValueIx (Maybe Value) (Maybe v)
key = valueAt . ObjIx
traverseArray :: (ToJSON v, FromJSON v)
=> SimpleIndexedTraversal Int (Maybe Value) (Maybe v)
traverseArray = index $ \f m -> case m of
Just (Array (map fromJSONMaybe . V.toList -> v)) ->
Just . Array . V.fromList . map toJSON . catMaybes <$> withIndex traverseList f v
v -> pure v
traverseObject :: (ToJSON v, FromJSON v)
=> SimpleIndexedTraversal T.Text (Maybe Value) (Maybe v)
traverseObject = index $ \f m -> case m of
Just (Object (expand . HMS.toList -> v)) ->
Just . Object . HMS.fromList . catMaybes . collapse <$> withIndex traverseAssocList f v
v -> pure v
where
expand = map (_2 %~ fromJSONMaybe)
collapse = map (\(a, b) -> (a, ) . toJSON <$> b)
traverseAssocList :: SimpleIndexedTraversal k [(k, v)] v
traverseAssocList = index $ \f m -> go f m where
go _ [] = pure []
go f ((k, v): xs) = (\v' ys -> (k, v') : ys) <$> f k v <*> go f xs