module Data.Aeson.Lens (
ValueIx(..),
valueAt,
arr, obj,
) where
import Control.Applicative
import Control.Lens
import Data.Aeson
import qualified Data.HashMap.Strict as HMS
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
arr :: (ToJSON v, FromJSON v)
=> Int
-> SimpleIndexedLens ValueIx (Maybe Value) (Maybe v)
arr = valueAt . ArrIx
obj :: (ToJSON v, FromJSON v)
=> T.Text
-> SimpleIndexedLens ValueIx (Maybe Value) (Maybe v)
obj = valueAt . ObjIx