{-# OPTIONS_GHC -Wno-unused-do-bind #-}
module Data.Aeson.JSONPath.Parser.Query
  ( pRootQuery
  , pCurrentQuery )
  where

import qualified Data.Text                      as T
import qualified Text.ParserCombinators.Parsec  as P

import Data.Functor                  (($>))
import Data.Maybe                    (isNothing)
import Text.ParserCombinators.Parsec ((<|>))

import Data.Aeson.JSONPath.Parser.Filter (pFilter)
import Data.Aeson.JSONPath.Parser.Name
import Data.Aeson.JSONPath.Parser.Number
import Data.Aeson.JSONPath.Parser.Common
import Data.Aeson.JSONPath.Types

import Prelude

pRootQuery :: P.Parser Query
pRootQuery :: Parser Query
pRootQuery = do
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'$'
  [QuerySegment Query]
segs <- ParsecT String () Identity (QuerySegment Query)
-> ParsecT String () Identity [QuerySegment Query]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (ParsecT String () Identity (QuerySegment Query)
 -> ParsecT String () Identity [QuerySegment Query])
-> ParsecT String () Identity (QuerySegment Query)
-> ParsecT String () Identity [QuerySegment Query]
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity (QuerySegment Query)
-> ParsecT String () Identity (QuerySegment Query)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try ParsecT String () Identity (QuerySegment Query)
pSpacedOutSegments
  Query -> Parser Query
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Query -> Parser Query) -> Query -> Parser Query
forall a b. (a -> b) -> a -> b
$ Query { queryType :: QueryType
queryType = QueryType
Root, querySegments :: [QuerySegment Query]
querySegments = [QuerySegment Query]
segs }
    where
      pQ :: Parser Query
pQ = Parser Query -> Parser Query
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try Parser Query
pRootQuery Parser Query -> Parser Query -> Parser Query
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Query -> Parser Query
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try Parser Query
pCurrentQuery
      pSpacedOutSegments :: ParsecT String () Identity (QuerySegment Query)
pSpacedOutSegments = Parser String
pSpaces Parser String
-> ParsecT String () Identity (QuerySegment Query)
-> ParsecT String () Identity (QuerySegment Query)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Query -> ParsecT String () Identity (QuerySegment Query)
forall a. Parser a -> Parser (QuerySegment a)
pQuerySegment Parser Query
pQ

pCurrentQuery :: P.Parser Query
pCurrentQuery :: Parser Query
pCurrentQuery = do
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'@'
  [QuerySegment Query]
segs <- ParsecT String () Identity (QuerySegment Query)
-> ParsecT String () Identity [QuerySegment Query]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (ParsecT String () Identity (QuerySegment Query)
 -> ParsecT String () Identity [QuerySegment Query])
-> ParsecT String () Identity (QuerySegment Query)
-> ParsecT String () Identity [QuerySegment Query]
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity (QuerySegment Query)
-> ParsecT String () Identity (QuerySegment Query)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try ParsecT String () Identity (QuerySegment Query)
pSpacedOutSegments
  Query -> Parser Query
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Query -> Parser Query) -> Query -> Parser Query
forall a b. (a -> b) -> a -> b
$ Query { queryType :: QueryType
queryType = QueryType
Current, querySegments :: [QuerySegment Query]
querySegments = [QuerySegment Query]
segs }
    where
      pQ :: Parser Query
pQ = Parser Query -> Parser Query
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try Parser Query
pRootQuery Parser Query -> Parser Query -> Parser Query
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Query -> Parser Query
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try Parser Query
pCurrentQuery
      pSpacedOutSegments :: ParsecT String () Identity (QuerySegment Query)
pSpacedOutSegments = Parser String
pSpaces Parser String
-> ParsecT String () Identity (QuerySegment Query)
-> ParsecT String () Identity (QuerySegment Query)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Query -> ParsecT String () Identity (QuerySegment Query)
forall a. Parser a -> Parser (QuerySegment a)
pQuerySegment Parser Query
pQ


pQuerySegment :: P.Parser a -> P.Parser (QuerySegment a)
pQuerySegment :: forall a. Parser a -> Parser (QuerySegment a)
pQuerySegment Parser a
pQ = do
  Maybe String
dotdot <- Parser String -> ParsecT String () Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"..")
  Segment a
seg <- Parser a -> Bool -> Parser (Segment a)
forall a. Parser a -> Bool -> Parser (Segment a)
pSegment Parser a
pQ (Bool -> Parser (Segment a)) -> Bool -> Parser (Segment a)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
dotdot
  let segType :: SegmentType
segType = if Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
dotdot then SegmentType
Child else SegmentType
Descendant
  QuerySegment a -> Parser (QuerySegment a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (QuerySegment a -> Parser (QuerySegment a))
-> QuerySegment a -> Parser (QuerySegment a)
forall a b. (a -> b) -> a -> b
$ QuerySegment { segmentType :: SegmentType
segmentType = SegmentType
segType, segment :: Segment a
segment = Segment a
seg }

pSegment :: P.Parser a -> Bool -> P.Parser (Segment a)
pSegment :: forall a. Parser a -> Bool -> Parser (Segment a)
pSegment Parser a
pQ Bool
isChild
        = GenParser Char () (Segment a) -> GenParser Char () (Segment a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try (Parser a -> GenParser Char () (Segment a)
forall a. Parser a -> Parser (Segment a)
pBracketed Parser a
pQ)
       GenParser Char () (Segment a)
-> GenParser Char () (Segment a) -> GenParser Char () (Segment a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () (Segment a) -> GenParser Char () (Segment a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try (Bool -> GenParser Char () (Segment a)
forall a. Bool -> Parser (Segment a)
pDotted Bool
isChild)
       GenParser Char () (Segment a)
-> GenParser Char () (Segment a) -> GenParser Char () (Segment a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () (Segment a) -> GenParser Char () (Segment a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try (Bool -> GenParser Char () (Segment a)
forall a. Bool -> Parser (Segment a)
pWildcardSeg Bool
isChild)

pBracketed :: P.Parser a -> P.Parser (Segment a)
pBracketed :: forall a. Parser a -> Parser (Segment a)
pBracketed Parser a
pQ = do
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'['
  Parser String
pSpaces
  Selector a
sel <- Parser a -> Parser (Selector a)
forall a. Parser a -> Parser (Selector a)
pSelector Parser a
pQ
  [Selector a]
optionalSels <- Parser (Selector a) -> ParsecT String () Identity [Selector a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (Parser (Selector a) -> ParsecT String () Identity [Selector a])
-> Parser (Selector a) -> ParsecT String () Identity [Selector a]
forall a b. (a -> b) -> a -> b
$ Parser a -> Parser (Selector a)
forall a. Parser a -> Parser (Selector a)
pCommaSepSelectors Parser a
pQ
  Parser String
pSpaces
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
']'
  Segment a -> Parser (Segment a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Segment a -> Parser (Segment a))
-> Segment a -> Parser (Segment a)
forall a b. (a -> b) -> a -> b
$ [Selector a] -> Segment a
forall a. [Selector a] -> Segment a
Bracketed (Selector a
selSelector a -> [Selector a] -> [Selector a]
forall a. a -> [a] -> [a]
:[Selector a]
optionalSels)
    where
      pCommaSepSelectors :: P.Parser a -> P.Parser (Selector a)
      pCommaSepSelectors :: forall a. Parser a -> Parser (Selector a)
pCommaSepSelectors Parser a
p = GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try (GenParser Char () (Selector a) -> GenParser Char () (Selector a))
-> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall a b. (a -> b) -> a -> b
$ Parser String
pSpaces Parser String
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
',' ParsecT String () Identity Char -> Parser String -> Parser String
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
pSpaces Parser String
-> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a -> GenParser Char () (Selector a)
forall a. Parser a -> Parser (Selector a)
pSelector Parser a
p


pDotted :: Bool -> P.Parser (Segment a)
pDotted :: forall a. Bool -> Parser (Segment a)
pDotted Bool
isChild = do
  (if Bool
isChild then String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"." else String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"")
  ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"_" ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
pUnicodeChar)
  Text
key <- String -> Text
T.pack (String -> Text)
-> Parser String -> ParsecT String () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"_" ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
pUnicodeChar)
  Segment a -> Parser (Segment a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Segment a -> Parser (Segment a))
-> Segment a -> Parser (Segment a)
forall a b. (a -> b) -> a -> b
$ Text -> Segment a
forall a. Text -> Segment a
Dotted Text
key


pWildcardSeg :: Bool -> P.Parser (Segment a)
pWildcardSeg :: forall a. Bool -> Parser (Segment a)
pWildcardSeg Bool
isChild = (if Bool
isChild then String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"." else String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"") Parser String
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'*' ParsecT String () Identity Char
-> Segment a -> ParsecT String () Identity (Segment a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Segment a
forall a. Segment a
WildcardSegment
  
pSelector :: P.Parser a -> P.Parser (Selector a)
pSelector :: forall a. Parser a -> Parser (Selector a)
pSelector Parser a
pQ = GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try GenParser Char () (Selector a)
forall a. Parser (Selector a)
pName
                   GenParser Char () (Selector a)
-> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try GenParser Char () (Selector a)
forall a. Parser (Selector a)
pSlice 
                   GenParser Char () (Selector a)
-> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try GenParser Char () (Selector a)
forall a. Parser (Selector a)
pIndex
                   GenParser Char () (Selector a)
-> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try GenParser Char () (Selector a)
forall a. Parser (Selector a)
pWildcardSel
                   GenParser Char () (Selector a)
-> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () (Selector a) -> GenParser Char () (Selector a)
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try (Parser a -> GenParser Char () (Selector a)
forall a. Parser a -> Parser (Selector a)
pFilter Parser a
pQ)

pName :: P.Parser (Selector a)
pName :: forall a. Parser (Selector a)
pName = Text -> Selector a
forall a. Text -> Selector a
Name (Text -> Selector a) -> (String -> Text) -> String -> Selector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Selector a)
-> Parser String -> ParsecT String () Identity (Selector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try Parser String
pSingleQuotted Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
P.try Parser String
pDoubleQuotted)

pIndex :: P.Parser (Selector a)
pIndex :: forall a. Parser (Selector a)
pIndex = Int -> Selector a
forall a. Int -> Selector a
Index (Int -> Selector a)
-> ParsecT String () Identity Int
-> ParsecT String () Identity (Selector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Int
pSignedInt

pSlice :: P.Parser (Selector a)
pSlice :: forall a. Parser (Selector a)
pSlice = do
  Maybe Int
start <- ParsecT String () Identity Int
-> ParsecT String () Identity (Maybe Int)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (ParsecT String () Identity Int
pSignedInt ParsecT String () Identity Int
-> Parser String -> ParsecT String () Identity Int
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
pSpaces)
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
':'
  Parser String
pSpaces
  Maybe Int
end <- ParsecT String () Identity Int
-> ParsecT String () Identity (Maybe Int)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (ParsecT String () Identity Int
pSignedInt ParsecT String () Identity Int
-> Parser String -> ParsecT String () Identity Int
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
pSpaces)
  Maybe (Maybe Int)
step <- ParsecT String () Identity (Maybe Int)
-> ParsecT String () Identity (Maybe (Maybe Int))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
':' ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Int)
-> ParsecT String () Identity (Maybe Int)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Int
-> ParsecT String () Identity (Maybe Int)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (Parser String
pSpaces Parser String
-> ParsecT String () Identity Int -> ParsecT String () Identity Int
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Int
pSignedInt))
  Selector a -> Parser (Selector a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Selector a -> Parser (Selector a))
-> Selector a -> Parser (Selector a)
forall a b. (a -> b) -> a -> b
$ (Maybe Int, Maybe Int, Int) -> Selector a
forall a. (Maybe Int, Maybe Int, Int) -> Selector a
ArraySlice (Maybe Int
start, Maybe Int
end, case Maybe (Maybe Int)
step of
    Just (Just Int
n) -> Int
n
    Maybe (Maybe Int)
_ -> Int
1)


pWildcardSel :: P.Parser (Selector a)
pWildcardSel :: forall a. Parser (Selector a)
pWildcardSel = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'*' ParsecT String () Identity Char
-> Selector a -> ParsecT String () Identity (Selector a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Selector a
forall a. Selector a
WildcardSelector