{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Data.JSONPath.Parser (jsonPathElement, jsonPath) where

import qualified Data.Char as Char
import Data.Functor
import Data.Functor.Identity
import Data.JSONPath.Types
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Void (Void)
import Text.Megaparsec as P
import Text.Megaparsec.Char (char, space, string)
import qualified Text.Megaparsec.Char.Lexer as L

type Parser = P.ParsecT Void Text Identity

jsonPath :: Parser a -> Parser [JSONPathElement]
jsonPath :: Parser a -> Parser [JSONPathElement]
jsonPath Parser a
endParser = do
  Maybe Char
_ <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity (Maybe Char))
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'$'
  ParsecT Void Text Identity JSONPathElement
-> Parser a -> Parser [JSONPathElement]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity JSONPathElement
jsonPathElement (Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead Parser a
endParser)

jsonPathElement :: Parser JSONPathElement
jsonPathElement :: ParsecT Void Text Identity JSONPathElement
jsonPathElement =
  ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity JSONPathElement
 -> ParsecT Void Text Identity JSONPathElement)
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall a b. (a -> b) -> a -> b
$
    ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity JSONPathElement
anyChild
      ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity JSONPathElement
keyChild
      ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity JSONPathElement
slice
      ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity JSONPathElement
indexChild
      ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity JSONPathElement
union
      ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity JSONPathElement
filterParser
      ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity JSONPathElement
search
      ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity JSONPathElement
searchBeginningWithSlice

indexChild :: Parser JSONPathElement
indexChild :: ParsecT Void Text Identity JSONPathElement
indexChild = Int -> JSONPathElement
IndexChild (Int -> JSONPathElement)
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall a. Parser a -> Parser a
inSqBr ParsecT Void Text Identity Int
indexChildWithoutBrackets

indexChildWithoutBrackets :: Parser Int
indexChildWithoutBrackets :: ParsecT Void Text Identity Int
indexChildWithoutBrackets = ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int)
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

slice :: Parser JSONPathElement
slice :: ParsecT Void Text Identity JSONPathElement
slice =
  (Maybe Int -> Maybe Int -> Maybe Int -> JSONPathElement)
-> (Maybe Int, Maybe Int, Maybe Int) -> JSONPathElement
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Maybe Int -> Maybe Int -> Maybe Int -> JSONPathElement
Slice
    ((Maybe Int, Maybe Int, Maybe Int) -> JSONPathElement)
-> ParsecT Void Text Identity (Maybe Int, Maybe Int, Maybe Int)
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Maybe Int, Maybe Int, Maybe Int)
-> ParsecT Void Text Identity (Maybe Int, Maybe Int, Maybe Int)
forall a. Parser a -> Parser a
inSqBr ParsecT Void Text Identity (Maybe Int, Maybe Int, Maybe Int)
sliceWithoutBrackets

sliceWithoutBrackets :: Parser (Maybe Int, Maybe Int, Maybe Int)
sliceWithoutBrackets :: ParsecT Void Text Identity (Maybe Int, Maybe Int, Maybe Int)
sliceWithoutBrackets = do
  (,,)
    (Maybe Int
 -> Maybe Int -> Maybe Int -> (Maybe Int, Maybe Int, Maybe Int))
-> ParsecT Void Text Identity (Maybe Int)
-> ParsecT
     Void
     Text
     Identity
     (Maybe Int -> Maybe Int -> (Maybe Int, Maybe Int, Maybe Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Maybe Int)
parseStart
    ParsecT
  Void
  Text
  Identity
  (Maybe Int -> Maybe Int -> (Maybe Int, Maybe Int, Maybe Int))
-> ParsecT Void Text Identity (Maybe Int)
-> ParsecT
     Void Text Identity (Maybe Int -> (Maybe Int, Maybe Int, Maybe Int))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Maybe Int)
parseEnd
    ParsecT
  Void Text Identity (Maybe Int -> (Maybe Int, Maybe Int, Maybe Int))
-> ParsecT Void Text Identity (Maybe Int)
-> ParsecT Void Text Identity (Maybe Int, Maybe Int, Maybe Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Maybe Int)
parseStep
  where
    parseStart :: Parser (Maybe Int)
    parseStart :: ParsecT Void Text Identity (Maybe Int)
parseStart =
      ParsecT Void Text Identity (Maybe Int)
-> ParsecT Void Text Identity (Maybe Int)
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal))
        ParsecT Void Text Identity (Maybe Int)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'

    parseEnd :: ParsecT Void Text Identity (Maybe Int)
parseEnd =
      ParsecT Void Text Identity (Maybe Int)
-> ParsecT Void Text Identity (Maybe Int)
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity (Maybe Int)
 -> ParsecT Void Text Identity (Maybe Int))
-> ParsecT Void Text Identity (Maybe Int)
-> ParsecT Void Text Identity (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Int
 -> ParsecT Void Text Identity (Maybe Int))
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

    parseStep :: ParsecT Void Text Identity (Maybe Int)
parseStep =
      ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':')
        ParsecT Void Text Identity (Maybe Char)
-> ParsecT Void Text Identity (Maybe Int)
-> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (Maybe Int)
-> ParsecT Void Text Identity (Maybe Int)
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal))

keyChild :: Parser JSONPathElement
keyChild :: ParsecT Void Text Identity JSONPathElement
keyChild = Text -> JSONPathElement
KeyChild (Text -> JSONPathElement)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
sqBrKeyChild ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
dotKeyChild)

sqBrKeyChild :: Parser Text
sqBrKeyChild :: ParsecT Void Text Identity Text
sqBrKeyChild =
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
inSqBr (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
ignoreSurroundingSpace ParsecT Void Text Identity Text
quotedString

dotKeyChild :: Parser Text
dotKeyChild :: ParsecT Void Text Identity Text
dotKeyChild = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
Char.isAlphaNum Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')

anyChild :: Parser JSONPathElement
anyChild :: ParsecT Void Text Identity JSONPathElement
anyChild = ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity JSONPathElement
 -> ParsecT Void Text Identity JSONPathElement)
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall a b. (a -> b) -> a -> b
$ JSONPathElement
AnyChild JSONPathElement
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
".*") ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
inSqBr (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*')))

union :: Parser JSONPathElement
union :: ParsecT Void Text Identity JSONPathElement
union =
  ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall a. Parser a -> Parser a
inSqBr (ParsecT Void Text Identity JSONPathElement
 -> ParsecT Void Text Identity JSONPathElement)
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall a b. (a -> b) -> a -> b
$
    [UnionElement] -> JSONPathElement
Union ([UnionElement] -> JSONPathElement)
-> ParsecT Void Text Identity [UnionElement]
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      UnionElement
firstElement <- Parser UnionElement
unionElement
      [UnionElement]
restElements <- Parser UnionElement -> ParsecT Void Text Identity [UnionElement]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char
-> Parser UnionElement -> Parser UnionElement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser UnionElement
unionElement)
      [UnionElement] -> ParsecT Void Text Identity [UnionElement]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnionElement
firstElement UnionElement -> [UnionElement] -> [UnionElement]
forall a. a -> [a] -> [a]
: [UnionElement]
restElements)

unionElement :: Parser UnionElement
unionElement :: Parser UnionElement
unionElement =
  Parser UnionElement -> Parser UnionElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((Maybe Int -> Maybe Int -> Maybe Int -> UnionElement)
-> (Maybe Int, Maybe Int, Maybe Int) -> UnionElement
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Maybe Int -> Maybe Int -> Maybe Int -> UnionElement
UESlice ((Maybe Int, Maybe Int, Maybe Int) -> UnionElement)
-> ParsecT Void Text Identity (Maybe Int, Maybe Int, Maybe Int)
-> Parser UnionElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Maybe Int, Maybe Int, Maybe Int)
sliceWithoutBrackets)
    Parser UnionElement -> Parser UnionElement -> Parser UnionElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UnionElement -> Parser UnionElement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Int -> UnionElement
UEIndexChild (Int -> UnionElement)
-> ParsecT Void Text Identity Int -> Parser UnionElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
indexChildWithoutBrackets)
    Parser UnionElement -> Parser UnionElement -> Parser UnionElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> UnionElement
UEKeyChild (Text -> UnionElement)
-> ParsecT Void Text Identity Text -> Parser UnionElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
ignoreSurroundingSpace ParsecT Void Text Identity Text
quotedString

filterParser :: Parser JSONPathElement
filterParser :: ParsecT Void Text Identity JSONPathElement
filterParser = ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall a. Parser a -> Parser a
inSqBr (ParsecT Void Text Identity JSONPathElement
 -> ParsecT Void Text Identity JSONPathElement)
-> ParsecT Void Text Identity JSONPathElement
-> ParsecT Void Text Identity JSONPathElement
forall a b. (a -> b) -> a -> b
$ do
  Char
_ <- ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'?'
  FilterExpr -> JSONPathElement
Filter (FilterExpr -> JSONPathElement)
-> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
filterExpr (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
ignoreSurroundingSpace (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']'))

filterExpr :: Parser a -> Parser FilterExpr
filterExpr :: Parser a -> ParsecT Void Text Identity FilterExpr
filterExpr Parser a
endParser =
  ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser a -> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
orFilterExpr Parser a
endParser)
    ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser a -> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
andFilterExpr Parser a
endParser)
    ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a -> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
basicFilterExpr Parser a
endParser

basicFilterExpr :: Parser a -> Parser FilterExpr
basicFilterExpr :: Parser a -> ParsecT Void Text Identity FilterExpr
basicFilterExpr Parser a
endParser = do
  Maybe Char
maybeNot <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'!')
  FilterExpr
expr <-
    ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser a -> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
comparisionFilterExpr Parser a
endParser)
      ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser a -> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
existsFilterExpr Parser a
endParser)
      ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> Parser a
inParens (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
filterExpr ParsecT Void Text Identity Char
closingParen) ParsecT Void Text Identity FilterExpr
-> Parser a -> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead Parser a
endParser)
  case Maybe Char
maybeNot of
    Maybe Char
Nothing -> FilterExpr -> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilterExpr
expr
    Just Char
_ -> FilterExpr -> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilterExpr -> ParsecT Void Text Identity FilterExpr)
-> FilterExpr -> ParsecT Void Text Identity FilterExpr
forall a b. (a -> b) -> a -> b
$ FilterExpr -> FilterExpr
Not FilterExpr
expr

comparisionFilterExpr :: Parser a -> Parser FilterExpr
comparisionFilterExpr :: Parser a -> ParsecT Void Text Identity FilterExpr
comparisionFilterExpr Parser a
endParser = do
  FilterExpr
expr <-
    Comparable -> Condition -> Comparable -> FilterExpr
ComparisonExpr
      (Comparable -> Condition -> Comparable -> FilterExpr)
-> ParsecT Void Text Identity Comparable
-> ParsecT
     Void Text Identity (Condition -> Comparable -> FilterExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Condition -> ParsecT Void Text Identity Comparable
forall a. Parser a -> ParsecT Void Text Identity Comparable
comparable Parser Condition
condition
      ParsecT Void Text Identity (Condition -> Comparable -> FilterExpr)
-> Parser Condition
-> ParsecT Void Text Identity (Comparable -> FilterExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Condition
condition
      ParsecT Void Text Identity (Comparable -> FilterExpr)
-> ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> ParsecT Void Text Identity Comparable
forall a. Parser a -> ParsecT Void Text Identity Comparable
comparable Parser a
endParser
  a
_ <- Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead Parser a
endParser
  FilterExpr -> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilterExpr
expr

existsFilterExpr :: Parser a -> Parser FilterExpr
existsFilterExpr :: Parser a -> ParsecT Void Text Identity FilterExpr
existsFilterExpr Parser a
endParser =
  SingularPath -> FilterExpr
ExistsExpr (SingularPath -> FilterExpr)
-> ParsecT Void Text Identity SingularPath
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> ParsecT Void Text Identity SingularPath
forall a. Parser a -> ParsecT Void Text Identity SingularPath
singularPath Parser a
endParser

singularPath :: Parser a -> Parser SingularPath
singularPath :: Parser a -> ParsecT Void Text Identity SingularPath
singularPath Parser a
endParser =
  BeginningPoint -> [SingularPathElement] -> SingularPath
SingularPath
    (BeginningPoint -> [SingularPathElement] -> SingularPath)
-> ParsecT Void Text Identity BeginningPoint
-> ParsecT
     Void Text Identity ([SingularPathElement] -> SingularPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity BeginningPoint
beginningPoint
    ParsecT Void Text Identity ([SingularPathElement] -> SingularPath)
-> ParsecT Void Text Identity [SingularPathElement]
-> ParsecT Void Text Identity SingularPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity SingularPathElement
-> Parser a -> ParsecT Void Text Identity [SingularPathElement]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity SingularPathElement
singularPathElement (Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead Parser a
endParser)

singularPathElement :: Parser SingularPathElement
singularPathElement :: ParsecT Void Text Identity SingularPathElement
singularPathElement =
  (Text -> SingularPathElement
Key (Text -> SingularPathElement)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity SingularPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
dotKeyChild)
    ParsecT Void Text Identity SingularPathElement
-> ParsecT Void Text Identity SingularPathElement
-> ParsecT Void Text Identity SingularPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> SingularPathElement
Key (Text -> SingularPathElement)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity SingularPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
sqBrKeyChild)
    ParsecT Void Text Identity SingularPathElement
-> ParsecT Void Text Identity SingularPathElement
-> ParsecT Void Text Identity SingularPathElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> SingularPathElement
Index (Int -> SingularPathElement)
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity SingularPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall a. Parser a -> Parser a
inSqBr ParsecT Void Text Identity Int
indexChildWithoutBrackets

orFilterExpr :: Parser a -> Parser FilterExpr
orFilterExpr :: Parser a -> ParsecT Void Text Identity FilterExpr
orFilterExpr Parser a
endParser = do
  let orOperator :: ParsecT Void Text Identity Text
orOperator = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"||"
  FilterExpr
e1 <-
    -- If there is an '&&' operation, it should take precedence over the '||'
    ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
andFilterExpr ParsecT Void Text Identity Text
orOperator)
      ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
basicFilterExpr ParsecT Void Text Identity Text
orOperator
  Text
_ <- ParsecT Void Text Identity Text
orOperator
  FilterExpr -> FilterExpr -> FilterExpr
Or FilterExpr
e1 (FilterExpr -> FilterExpr)
-> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
filterExpr Parser a
endParser

andFilterExpr :: Parser a -> Parser FilterExpr
andFilterExpr :: Parser a -> ParsecT Void Text Identity FilterExpr
andFilterExpr Parser a
endParser = do
  let andOperator :: ParsecT Void Text Identity Text
andOperator = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"&&"
  FilterExpr
e1 <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
basicFilterExpr ParsecT Void Text Identity Text
andOperator
  Text
_ <- ParsecT Void Text Identity Text
andOperator
  FilterExpr -> FilterExpr -> FilterExpr
And FilterExpr
e1 (FilterExpr -> FilterExpr)
-> ParsecT Void Text Identity FilterExpr
-> ParsecT Void Text Identity FilterExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> ParsecT Void Text Identity FilterExpr
forall a. Parser a -> ParsecT Void Text Identity FilterExpr
filterExpr Parser a
endParser

search :: Parser JSONPathElement
search :: ParsecT Void Text Identity JSONPathElement
search = do
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
  Char
_ <- ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.')
  [JSONPathElement] -> JSONPathElement
Search ([JSONPathElement] -> JSONPathElement)
-> Parser [JSONPathElement]
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity JSONPathElement
-> Parser [JSONPathElement]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity JSONPathElement
jsonPathElement

searchBeginningWithSlice :: Parser JSONPathElement
searchBeginningWithSlice :: ParsecT Void Text Identity JSONPathElement
searchBeginningWithSlice = do
  Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
".."
  Char
_ <- ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[')
  [JSONPathElement] -> JSONPathElement
Search ([JSONPathElement] -> JSONPathElement)
-> Parser [JSONPathElement]
-> ParsecT Void Text Identity JSONPathElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity JSONPathElement
-> Parser [JSONPathElement]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity JSONPathElement
jsonPathElement

beginningPoint :: Parser BeginningPoint
beginningPoint :: ParsecT Void Text Identity BeginningPoint
beginningPoint =
  ParsecT Void Text Identity BeginningPoint
-> ParsecT Void Text Identity BeginningPoint
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'$' ParsecT Void Text Identity Char
-> BeginningPoint -> ParsecT Void Text Identity BeginningPoint
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BeginningPoint
Root)
    ParsecT Void Text Identity BeginningPoint
-> ParsecT Void Text Identity BeginningPoint
-> ParsecT Void Text Identity BeginningPoint
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@' ParsecT Void Text Identity Char
-> BeginningPoint -> ParsecT Void Text Identity BeginningPoint
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BeginningPoint
CurrentObject)

condition :: Parser Condition
condition :: Parser Condition
condition =
  Parser Condition -> Parser Condition
forall a. Parser a -> Parser a
ignoreSurroundingSpace (Parser Condition -> Parser Condition)
-> Parser Condition -> Parser Condition
forall a b. (a -> b) -> a -> b
$
    Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"==" ParsecT Void Text Identity Text -> Condition -> Parser Condition
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Condition
Equal
      Parser Condition -> Parser Condition -> Parser Condition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"!=" ParsecT Void Text Identity Text -> Condition -> Parser Condition
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Condition
NotEqual
      Parser Condition -> Parser Condition -> Parser Condition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"<=" ParsecT Void Text Identity Text -> Condition -> Parser Condition
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Condition
SmallerThanOrEqual
      Parser Condition -> Parser Condition -> Parser Condition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
">=" ParsecT Void Text Identity Text -> Condition -> Parser Condition
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Condition
GreaterThanOrEqual
      Parser Condition -> Parser Condition -> Parser Condition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
">" ParsecT Void Text Identity Text -> Condition -> Parser Condition
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Condition
GreaterThan
      Parser Condition -> Parser Condition -> Parser Condition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"<" ParsecT Void Text Identity Text -> Condition -> Parser Condition
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Condition
SmallerThan

comparable :: Parser a -> Parser Comparable
comparable :: Parser a -> ParsecT Void Text Identity Comparable
comparable Parser a
endParser = do
  Scientific -> Comparable
CmpNumber (Scientific -> Comparable)
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
L.scientific
    ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Comparable
CmpString (Text -> Comparable)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
quotedString
    ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Comparable
CmpBool (Bool -> Comparable)
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Bool
bool
    ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Comparable
CmpNull Comparable
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"null"
    ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity Comparable
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SingularPath -> Comparable
CmpPath (SingularPath -> Comparable)
-> ParsecT Void Text Identity SingularPath
-> ParsecT Void Text Identity Comparable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> ParsecT Void Text Identity SingularPath
forall a. Parser a -> ParsecT Void Text Identity SingularPath
singularPath Parser a
endParser

bool :: Parser Bool
bool :: ParsecT Void Text Identity Bool
bool =
  Bool
True Bool
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"true"
    ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False Bool
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"false"

ignoreSurroundingSpace :: Parser a -> Parser a
ignoreSurroundingSpace :: Parser a -> Parser a
ignoreSurroundingSpace Parser a
p = ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

inSqBr :: Parser a -> Parser a
inSqBr :: Parser a -> Parser a
inSqBr Parser a
p = ParsecT Void Text Identity Char
openingSqBr ParsecT Void Text Identity Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> ParsecT Void Text Identity Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
closingSqBr

openingSqBr :: Parser Char
openingSqBr :: ParsecT Void Text Identity Char
openingSqBr = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
ignoreSurroundingSpace (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[')

closingSqBr :: Parser Char
closingSqBr :: ParsecT Void Text Identity Char
closingSqBr = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
ignoreSurroundingSpace (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']')

inParens :: Parser a -> Parser a
inParens :: Parser a -> Parser a
inParens Parser a
p = ParsecT Void Text Identity Char
openingParen ParsecT Void Text Identity Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> ParsecT Void Text Identity Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
closingParen

openingParen :: Parser Char
openingParen :: ParsecT Void Text Identity Char
openingParen = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
ignoreSurroundingSpace (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(')

closingParen :: Parser Char
closingParen :: ParsecT Void Text Identity Char
closingParen = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
ignoreSurroundingSpace (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')')

quotedString :: Parser Text
quotedString :: ParsecT Void Text Identity Text
quotedString = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
ignoreSurroundingSpace (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Void Text Identity String
forall e s (f :: * -> *).
(MonadParsec e s f, Token s ~ Char) =>
Char -> f String
inQuotes Char
'"' ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Void Text Identity String
forall e s (f :: * -> *).
(MonadParsec e s f, Token s ~ Char) =>
Char -> f String
inQuotes Char
'\'')
  where
    inQuotes :: Char -> f String
inQuotes Char
quoteChar =
      Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
quoteChar f Char -> f String -> f String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f Char -> f Char -> f String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill f Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
quoteChar)

uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
f (a
a, b
b, c
c) = a -> b -> c -> d
f a
a b
b c
c