graphql-engine/server/src-lib/Data/Parser/JSONPath.hs
Toan Nguyen 15c0ebf1ef
allow special characters in json path's property name (close #3890) (#3892)
* allow underscore prefix and special characters in json path

* server: Rewrite/refactor JSONPath parser

The JSONPath parser is also rewritten, the previous implementation
was written in a very explicitly “recursive descent” style, but the whole
point of using attoparsec is to be able to backtrack! Taking advantage
of the combinators makes for a much simpler parser.

Co-authored-by: Vamshi Surabhi <0x777@users.noreply.github.com>
Co-authored-by: Alexis King <lexi.lambda@gmail.com>
Co-authored-by: Aleksandra Sikora <ola.zxcvbnm@gmail.com>
Co-authored-by: Shahidh K Muhammed <shahidh@hasura.io>
2020-04-20 14:25:09 +05:30

57 lines
1.7 KiB
Haskell

module Data.Parser.JSONPath
( parseJSONPath
, JSONPathElement(..)
, JSONPath
) where
import Data.Bifunctor
import qualified Data.Text as T
import Prelude
import Control.Applicative
import Data.Aeson.Internal (JSONPath, JSONPathElement (..))
import Data.Attoparsec.Text
parseJSONPath :: T.Text -> Either String JSONPath
parseJSONPath txt = first (const invalidMessage) $
parseOnly (optional (char '$') *> many1' element <* endOfInput) txt
where
invalidMessage = T.unpack txt
++ ". Accept letters, digits, underscore (_) or hyphen (-) only"
++ ". Use single quotes enclosed in bracket (['...']) if there is any special character"
element :: Parser JSONPathElement
element = Key <$> (optional (char '.') *> name) -- field or .field
<|> bracketElement -- [42] or ['field']
name :: Parser T.Text
name = go <?> "property name" where
go = do
firstChar <- letter
<|> char '_'
<?> "first character of property name must be a letter or underscore"
otherChars <- many' (letter <|> digit <|> satisfy (inClass "-_"))
pure $ T.pack (firstChar:otherChars)
-- | Parses a JSON property key or index in square bracket format, e.g.
-- > [42]
-- > ["hello"]
-- > ['你好']
bracketElement :: Parser JSONPathElement
bracketElement = do
optional (char '.') *> char '['
result <- Index <$> decimal
<|> Key <$> quotedString '"'
<|> Key <$> quotedString '\''
char ']'
pure result
where
quotedString delimiter = do
char delimiter
result <- T.pack <$> many' (charOrEscape delimiter)
char delimiter
pure result
charOrEscape delimiter = (char '\\' *> anyChar) <|> notChar delimiter