module Data.Aeson.JsonPointer.Internal
(
entryToken
, memberToken
, descend
) where
import Control.Applicative ((<|>))
import Control.Error (hush)
import Control.Monad (foldM)
import Data.Aeson (Value(..))
import Data.Aeson.Zipper
import Data.Attoparsec.Text (Parser, (<?>), atEnd, char, choice,
decimal, endOfInput, parseOnly, takeTill)
import Data.Text (Text)
import qualified Data.Text as T
entryToken :: Parser Int
entryToken = choice
[ char '-' *> fail "reference to nonexistent array entry"
, char '0' *> return 0
, decimal
] <* (endOfInput <?> "bad entry reference, expected")
memberToken :: Parser Text
memberToken = do
pref <- takeTill (== '~')
stop <- atEnd
if stop then return pref else do
ec <- unesc
suff <- memberToken
return $ pref `T.append` T.cons ec suff
where
unesc = char '~' *>
((char '0' *> return '~') <|> (char '1' *> return '/'))
descend :: Text
-> Location
-> Maybe Location
descend jp v
| T.head jp /= '/' = Nothing
| otherwise =
foldM step v $ T.split (== '/') (T.tail jp)
where
step loc@(Loc (Object _) _) ref = do
pr <- hush $ parseOnly memberToken ref
child pr loc
step loc@(Loc (Array _) _) ref = do
pr <- hush $ parseOnly entryToken ref
entry pr loc