module JSONPointer.Parser
(
Parser,
run,
jsonPointer,
)
where
import JSONPointer.Prelude
import Data.Attoparsec.Text
import qualified Data.Text
import qualified JSONPointer.Model as Model
run :: Parser a -> Text -> Either Text a
run parser input =
either (Left . fromString) Right $
parseOnly (parser <* endOfInput) input
jsonPointer :: Parser Model.JSONPointer
jsonPointer =
foldMany referenceToken
referenceToken :: Parser Model.JSONPointer
referenceToken =
char '/' *> (keyToModel <$> key)
where
key =
Data.Text.pack <$> referenceTokenChars
keyToModel !text =
Model.atIndexOrKey (textToIndexMaybe text) text
textToIndexMaybe =
either (const Nothing) Just .
parseOnly parser
where
parser =
decimal <* endOfInput
referenceTokenChars :: Parser [Char]
referenceTokenChars =
many $ escapeSequence <|> notChar '/'
where
escapeSequence =
char '~' *> (tilde <|> slash <|> other)
where
tilde =
char '0' $> '~'
slash =
char '1' $> '/'
other =
fail "Illegal escape sequence"
foldMany :: (Alternative m, Monoid a) => m a -> m a
foldMany consume =
step <|> end
where
step =
mappend <$> consume <*> foldMany consume
end =
pure mempty
shouldFail :: (Alternative m, Monad m) => m a -> m ()
shouldFail p =
join $ (p *> pure empty) <|> pure (pure ())