module Data.JSONPath.Types
  ( BeginningPoint(..)
  , Condition(..)
  , Literal(..)
  , JSONPathElement(..)
  , SliceElement(..)
  , module Data.JSONPath.ExecutionResult
  )
where

import Data.Text
import Data.JSONPath.ExecutionResult

data BeginningPoint = Root
                    | CurrentObject
  deriving (Int -> BeginningPoint -> ShowS
[BeginningPoint] -> ShowS
BeginningPoint -> String
(Int -> BeginningPoint -> ShowS)
-> (BeginningPoint -> String)
-> ([BeginningPoint] -> ShowS)
-> Show BeginningPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeginningPoint] -> ShowS
$cshowList :: [BeginningPoint] -> ShowS
show :: BeginningPoint -> String
$cshow :: BeginningPoint -> String
showsPrec :: Int -> BeginningPoint -> ShowS
$cshowsPrec :: Int -> BeginningPoint -> ShowS
Show, BeginningPoint -> BeginningPoint -> Bool
(BeginningPoint -> BeginningPoint -> Bool)
-> (BeginningPoint -> BeginningPoint -> Bool) -> Eq BeginningPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeginningPoint -> BeginningPoint -> Bool
$c/= :: BeginningPoint -> BeginningPoint -> Bool
== :: BeginningPoint -> BeginningPoint -> Bool
$c== :: BeginningPoint -> BeginningPoint -> Bool
Eq)

data Condition = Equal
               | NotEqual
               | GreaterThan
               | SmallerThan
  deriving (Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show, Condition -> Condition -> Bool
(Condition -> Condition -> Bool)
-> (Condition -> Condition -> Bool) -> Eq Condition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq)

data Literal = LitNumber Int
             | LitString Text
  deriving (Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show, Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq)

data SliceElement = SingleIndex Int
                  | SimpleSlice Int Int
                  | SliceWithStep Int Int Int
                  | SliceTo Int
                  | SliceToWithStep Int Int
                  | SliceFrom Int
                  | SliceFromWithStep Int Int
                  | SliceWithOnlyStep Int
  deriving (Int -> SliceElement -> ShowS
[SliceElement] -> ShowS
SliceElement -> String
(Int -> SliceElement -> ShowS)
-> (SliceElement -> String)
-> ([SliceElement] -> ShowS)
-> Show SliceElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SliceElement] -> ShowS
$cshowList :: [SliceElement] -> ShowS
show :: SliceElement -> String
$cshow :: SliceElement -> String
showsPrec :: Int -> SliceElement -> ShowS
$cshowsPrec :: Int -> SliceElement -> ShowS
Show, SliceElement -> SliceElement -> Bool
(SliceElement -> SliceElement -> Bool)
-> (SliceElement -> SliceElement -> Bool) -> Eq SliceElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SliceElement -> SliceElement -> Bool
$c/= :: SliceElement -> SliceElement -> Bool
== :: SliceElement -> SliceElement -> Bool
$c== :: SliceElement -> SliceElement -> Bool
Eq)

data JSONPathElement  = KeyChild Text
                      | KeyChildren [Text]
                      | AnyChild
                      | Slice SliceElement
                      | SliceUnion SliceElement SliceElement
                      | Filter BeginningPoint [JSONPathElement] Condition Literal
                      | Search [JSONPathElement]
  deriving (Int -> JSONPathElement -> ShowS
[JSONPathElement] -> ShowS
JSONPathElement -> String
(Int -> JSONPathElement -> ShowS)
-> (JSONPathElement -> String)
-> ([JSONPathElement] -> ShowS)
-> Show JSONPathElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONPathElement] -> ShowS
$cshowList :: [JSONPathElement] -> ShowS
show :: JSONPathElement -> String
$cshow :: JSONPathElement -> String
showsPrec :: Int -> JSONPathElement -> ShowS
$cshowsPrec :: Int -> JSONPathElement -> ShowS
Show, JSONPathElement -> JSONPathElement -> Bool
(JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> Eq JSONPathElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONPathElement -> JSONPathElement -> Bool
$c/= :: JSONPathElement -> JSONPathElement -> Bool
== :: JSONPathElement -> JSONPathElement -> Bool
$c== :: JSONPathElement -> JSONPathElement -> Bool
Eq)