module Data.Aeson.Zipper.Internal
(
Context(..)
, Location(..)
, anchor
, value
, getValue
, child
, sibling
, entry
, next
, previous
, up
, top
, replace
, addSibling
, addBefore
, addAfter
) where
import Data.Aeson (Object, Value(..))
import Data.List (uncons)
import Data.Text (Text)
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as H
type ValueList = [Value]
data Context
= Top
| Member !Text !Object !Context
| Entry !ValueList !ValueList Context
deriving (Show)
data Location = Loc Value Context deriving (Show)
anchor :: Value -> Maybe Location
anchor v = Just $ Loc v Top
value :: Location -> Value
value (Loc v _) = v
getValue :: Maybe Location -> Value
getValue = maybe Null value
child :: Text -> Location -> Maybe Location
child k (Loc (Object obj) ctx) = do
ch <- H.lookup k obj
return $ Loc ch (Member k (H.delete k obj) ctx)
child _ _ = Nothing
sibling :: Text -> Location -> Maybe Location
sibling k (Loc v (Member k' obj ctx)) = do
s <- H.lookup k obj
return $ Loc s $ Member k (H.insert k' v $ H.delete k obj) ctx
sibling _ _ = Nothing
entry :: Int -> Location -> Maybe Location
entry n (Loc (Array ary) ctx) = do
e <- s V.!? 0
return $ Loc e $ Entry (V.toList p) (V.toList $ V.tail s) ctx
where
(p,s) = V.splitAt n ary
entry _ _ = Nothing
next :: Location -> Maybe Location
next (Loc v (Entry p s ctx)) = do
(v',s') <- uncons s
return $ Loc v' $ Entry (v:p) s' ctx
next _ = Nothing
previous :: Location -> Maybe Location
previous (Loc v (Entry p s ctx)) = do
(v',p') <- uncons p
return $ Loc v' $ Entry p' (v:s) ctx
previous _ = Nothing
up :: Location -> Maybe Location
up (Loc _ Top) = Nothing
up (Loc v (Member k obj ctx)) = Just $ Loc (Object $ H.insert k v obj) ctx
up (Loc v (Entry p s ctx)) = Just $
Loc (Array . V.fromList $ reverse p ++ v:s) ctx
top :: Location -> Maybe Location
top loc = case up loc of
Nothing -> Just loc
Just p -> top p
replace :: Value -> Location -> Maybe Location
replace v (Loc _ ctx) = Just $ Loc v ctx
addSibling :: Text -> Value -> Location -> Maybe Location
addSibling k v (Loc v' (Member k' obj ctx)) =
if H.member k obj
then Nothing
else Just $ Loc v (Member k (H.insert k' v' obj) ctx)
addSibling _ _ _ = Nothing
addBefore :: Value -> Location -> Maybe Location
addBefore v (Loc v' (Entry p s ctx)) = Just $ Loc v $ Entry p (v':s) ctx
addBefore _ _ = Nothing
addAfter :: Value -> Location -> Maybe Location
addAfter v (Loc v' (Entry p s ctx)) = Just $ Loc v $ Entry (v':p) s ctx
addAfter _ _ = Nothing