module Data.JSONPath.Types
  ( BeginningPoint (..),
    Condition (..),
    Comparable (..),
    JSONPathElement (..),
    UnionElement (..),
    FilterExpr (..),
    SingularPathElement (..),
    SingularPath (..),
  )
where

import Data.Scientific (Scientific)
import Data.Text

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)

-- | A JSONPath which finds at max one value, given a beginning point. Used by
-- 'FilterExpr' for 'ExistsExpr' and 'ComparisonExpr'.
data SingularPath
  = SingularPath BeginningPoint [SingularPathElement]
  deriving (Int -> SingularPath -> ShowS
[SingularPath] -> ShowS
SingularPath -> String
(Int -> SingularPath -> ShowS)
-> (SingularPath -> String)
-> ([SingularPath] -> ShowS)
-> Show SingularPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SingularPath] -> ShowS
$cshowList :: [SingularPath] -> ShowS
show :: SingularPath -> String
$cshow :: SingularPath -> String
showsPrec :: Int -> SingularPath -> ShowS
$cshowsPrec :: Int -> SingularPath -> ShowS
Show, SingularPath -> SingularPath -> Bool
(SingularPath -> SingularPath -> Bool)
-> (SingularPath -> SingularPath -> Bool) -> Eq SingularPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingularPath -> SingularPath -> Bool
$c/= :: SingularPath -> SingularPath -> Bool
== :: SingularPath -> SingularPath -> Bool
$c== :: SingularPath -> SingularPath -> Bool
Eq)

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

data Comparable
  = CmpNumber Scientific
  | CmpString Text
  | CmpBool Bool
  | CmpNull
  | CmpPath SingularPath
  deriving (Int -> Comparable -> ShowS
[Comparable] -> ShowS
Comparable -> String
(Int -> Comparable -> ShowS)
-> (Comparable -> String)
-> ([Comparable] -> ShowS)
-> Show Comparable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comparable] -> ShowS
$cshowList :: [Comparable] -> ShowS
show :: Comparable -> String
$cshow :: Comparable -> String
showsPrec :: Int -> Comparable -> ShowS
$cshowsPrec :: Int -> Comparable -> ShowS
Show, Comparable -> Comparable -> Bool
(Comparable -> Comparable -> Bool)
-> (Comparable -> Comparable -> Bool) -> Eq Comparable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comparable -> Comparable -> Bool
$c/= :: Comparable -> Comparable -> Bool
== :: Comparable -> Comparable -> Bool
$c== :: Comparable -> Comparable -> Bool
Eq)

data Condition
  = Equal
  | NotEqual
  | GreaterThan
  | SmallerThan
  | GreaterThanOrEqual
  | SmallerThanOrEqual
  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 FilterExpr
  = ExistsExpr SingularPath
  | ComparisonExpr Comparable Condition Comparable
  | And FilterExpr FilterExpr
  | Or FilterExpr FilterExpr
  | Not FilterExpr
  deriving (Int -> FilterExpr -> ShowS
[FilterExpr] -> ShowS
FilterExpr -> String
(Int -> FilterExpr -> ShowS)
-> (FilterExpr -> String)
-> ([FilterExpr] -> ShowS)
-> Show FilterExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterExpr] -> ShowS
$cshowList :: [FilterExpr] -> ShowS
show :: FilterExpr -> String
$cshow :: FilterExpr -> String
showsPrec :: Int -> FilterExpr -> ShowS
$cshowsPrec :: Int -> FilterExpr -> ShowS
Show, FilterExpr -> FilterExpr -> Bool
(FilterExpr -> FilterExpr -> Bool)
-> (FilterExpr -> FilterExpr -> Bool) -> Eq FilterExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterExpr -> FilterExpr -> Bool
$c/= :: FilterExpr -> FilterExpr -> Bool
== :: FilterExpr -> FilterExpr -> Bool
$c== :: FilterExpr -> FilterExpr -> Bool
Eq)

-- | Elements which can occur inside a union
data UnionElement
  = UEKeyChild Text
  | UEIndexChild Int
  | UESlice (Maybe Int) (Maybe Int) (Maybe Int)
  deriving (Int -> UnionElement -> ShowS
[UnionElement] -> ShowS
UnionElement -> String
(Int -> UnionElement -> ShowS)
-> (UnionElement -> String)
-> ([UnionElement] -> ShowS)
-> Show UnionElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnionElement] -> ShowS
$cshowList :: [UnionElement] -> ShowS
show :: UnionElement -> String
$cshow :: UnionElement -> String
showsPrec :: Int -> UnionElement -> ShowS
$cshowsPrec :: Int -> UnionElement -> ShowS
Show, UnionElement -> UnionElement -> Bool
(UnionElement -> UnionElement -> Bool)
-> (UnionElement -> UnionElement -> Bool) -> Eq UnionElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnionElement -> UnionElement -> Bool
$c/= :: UnionElement -> UnionElement -> Bool
== :: UnionElement -> UnionElement -> Bool
$c== :: UnionElement -> UnionElement -> Bool
Eq)

-- | A 'JSONPath' is a list of 'JSONPathElement's.
data JSONPathElement
  = -- | '$.foo' or '$["foo"]'
    KeyChild Text
  | -- | '$[1]'
    IndexChild Int
  | -- | '$[*]'
    AnyChild
  | -- | '$[1:7]', '$[0:10:2]', '$[::2]', '$[::]', etc.
    Slice (Maybe Int) (Maybe Int) (Maybe Int)
  | -- | '$[0,1,9]' or '$[0, 1:2, "foo", "bar"]'
    Union [UnionElement]
  | -- | '$[?(@.foo == 42)]', '$[?(@.foo > @.bar)]', etc.
    Filter FilterExpr
  | -- | '$..foo.bar'
    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)