mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-19 13:31:43 +03:00
bdacf1bd23
I spent half the day reducing a weird compile failure here https://github.com/hasura/graphql-engine-mono/pull/1593/files#r713102990 to this https://gitlab.haskell.org/ghc/ghc/-/issues/17768#note_378004. Seems ApplicativeDo makes a mess of non-applicative monadic do in some cases. Given our rather localized use of ApplicativeDo, seemed a good idea to remove it from the list of default extensions. It appears that ApplicativeDo also buries some unused return value warnings, so this PR also silences those. We should check that none of those warnings were warranted though. https://github.com/hasura/graphql-engine-mono/pull/2413 GitOrigin-RevId: 1874c1a82230431849265755b1407beebc947041
58 lines
1.8 KiB
Haskell
58 lines
1.8 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 Control.Monad (void)
|
|
import Data.Aeson.Internal (JSONPath, JSONPathElement (..))
|
|
import Data.Attoparsec.Text
|
|
|
|
parseJSONPath :: T.Text -> Either String JSONPath
|
|
parseJSONPath "$" = Right []
|
|
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
|
|
void $ optional (char '.') *> char '['
|
|
result <- Index <$> decimal
|
|
<|> Key <$> quotedString '"'
|
|
<|> Key <$> quotedString '\''
|
|
void $ char ']'
|
|
pure result
|
|
where
|
|
quotedString delimiter = do
|
|
void $ char delimiter
|
|
result <- T.pack <$> many' (charOrEscape delimiter)
|
|
void $ char delimiter
|
|
pure result
|
|
|
|
charOrEscape delimiter = (char '\\' *> anyChar) <|> notChar delimiter
|