{-# 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
'$'
  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
  return $ Query { queryType = Root, querySegments = 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
'@'
  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
  return $ Query { queryType = Current, querySegments = 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
  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
"..")
  seg <- pSegment pQ $ isNothing dotdot
  let segType = if Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
dotdot then SegmentType
Child else SegmentType
Descendant
  return $ QuerySegment { segmentType = segType, segment = 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
  sel <- Parser a -> Parser (Selector a)
forall a. Parser a -> Parser (Selector a)
pSelector Parser a
pQ
  optionalSels <- P.many $ pCommaSepSelectors pQ
  pSpaces
  P.char ']'
  return $ Bracketed (sel: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)
  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 u (m :: * -> *) a. 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)
  return $ Dotted 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
  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)
  P.char ':'
  pSpaces
  end <- P.optionMaybe (pSignedInt <* pSpaces)
  step <- P.optionMaybe (P.char ':' *> P.optionMaybe (pSpaces *> pSignedInt))
  return $ ArraySlice (start, end, case 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