mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
975b022b29
This reduces the usage of "utils" modules in the parsers code, especially those that are simply re-exported from elsewhere, to facilitate extracting the parsers code into its own library. It mostly inlines the imports that are re-exported from `Hasura.Prelude` and `Data.Parser.JSONPath`. It also removes references to `Data.*.Extended` modules. When necessary, it re-implements the functionality (which is typically trivial). It does not tackle all external dependencies. I observed the following that will take more work: - `Data.GADT.Compare.Extended` - `Data.Text.Extended` - `Hasura.Base.Error` - `Hasura.RQL.Types.Common` - `Hasura.Server.Utils` PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4964 GitOrigin-RevId: 54ad3c1b7a31f13e34340ebe9fcc36d0ad57b8bd
106 lines
3.3 KiB
Haskell
106 lines
3.3 KiB
Haskell
module Data.Parser.JSONPath
|
|
( encodeJSONPath,
|
|
parseJSONPath,
|
|
)
|
|
where
|
|
|
|
import Control.Applicative
|
|
import Data.Aeson (Key)
|
|
import Data.Aeson qualified as Aeson
|
|
import Data.Aeson.Internal (JSONPath, JSONPathElement (..))
|
|
import Data.Aeson.Key qualified as K
|
|
import Data.Attoparsec.Text
|
|
import Data.Bifunctor qualified as Bifunctor
|
|
import Data.Text qualified as T
|
|
import Data.Text.Lazy qualified as TL
|
|
import Data.Text.Lazy.Encoding qualified as TL
|
|
import Hasura.Prelude
|
|
|
|
-- | Encodes a JSON path as text that looks like code you would write
|
|
-- in order to traverse that path in JavaScript.
|
|
encodeJSONPath :: JSONPath -> Text
|
|
encodeJSONPath path = "$" <> foldMap formatPart path
|
|
where
|
|
formatPart (Index idx) = "[" <> tshow idx <> "]"
|
|
formatPart (Key key)
|
|
| specialChars stringKey = TL.toStrict ("[" <> TL.decodeUtf8 (Aeson.encode (Aeson.String textKey)) <> "]")
|
|
| otherwise = "." <> textKey
|
|
where
|
|
textKey = K.toText key
|
|
stringKey = T.unpack textKey
|
|
specialChars [] = True
|
|
-- first char must not be number
|
|
specialChars (c : xs) =
|
|
notElem c (alphabet ++ "_")
|
|
|| any (`notElem` (alphaNumerics ++ "_-")) xs
|
|
|
|
parseJSONPath :: Text -> Either Text JSONPath
|
|
parseJSONPath "$" = Right []
|
|
parseJSONPath txt =
|
|
Bifunctor.first (const invalidMessage) $
|
|
parseOnly (optional (char '$') *> many1' element <* endOfInput) txt
|
|
where
|
|
invalidMessage =
|
|
txt
|
|
<> ". Accept letters, digits, underscore (_) or hyphen (-) only"
|
|
<> ". Use quotes enclosed in bracket ([\"...\"]) if there is any special character"
|
|
|
|
element :: Parser JSONPathElement
|
|
element =
|
|
Key <$> (optional (char '.') *> name) -- field or .field
|
|
<|> bracketElement -- [42], ["field"], or ['field']
|
|
|
|
name :: Parser Key
|
|
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 $ K.fromText $ 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 <$> doubleQuotedString
|
|
<|> Key <$> singleQuotedString
|
|
void $ char ']'
|
|
pure result
|
|
where
|
|
parseJSONString inQuotes =
|
|
maybe (fail "Invalid JSON string") (pure . K.fromText) . Aeson.decode . TL.encodeUtf8 $
|
|
"\"" <> inQuotes <> "\""
|
|
|
|
doubleQuotedString = do
|
|
void $ char '"'
|
|
inQuotes <- TL.concat <$> many doubleQuotedChar
|
|
void $ char '"'
|
|
parseJSONString inQuotes
|
|
|
|
doubleQuotedChar = jsonChar '"'
|
|
|
|
-- Converts `'foo'` to `"foo"` and then parses it.
|
|
singleQuotedString = do
|
|
void $ char '\''
|
|
inQuotes <- TL.concat <$> many singleQuotedChar
|
|
void $ char '\''
|
|
parseJSONString inQuotes
|
|
|
|
-- Un-escapes single quotes, and escapes double quotes.
|
|
singleQuotedChar =
|
|
(string "\\'" *> pure "'")
|
|
<|> (string "\"" *> pure "\\\"")
|
|
<|> jsonChar '\''
|
|
|
|
jsonChar delimiter =
|
|
(("\\" <>) . TL.singleton <$> (char '\\' *> anyChar))
|
|
<|> (TL.singleton <$> notChar delimiter)
|