{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.Request.Types
  ( Alias
  , Depth
  , EmbedHint
  , EmbedPath
  , Field
  , Filter(..)
  , JoinCondition(..)
  , JsonOperand(..)
  , JsonOperation(..)
  , JsonPath
  , ListVal
  , LogicOperator(..)
  , LogicTree(..)
  , MutateQuery(..)
  , MutateRequest
  , NodeName
  , OpExpr(..)
  , Operation (..)
  , OrderDirection(..)
  , OrderNulls(..)
  , OrderTerm(..)
  , ReadNode
  , ReadQuery(..)
  , ReadRequest
  , SelectItem
  , SingleVal
  , fstFieldNames
  ) where

import qualified Data.ByteString.Lazy as BL
import qualified Data.Set             as S

import Data.Tree (Tree (..))

import qualified GHC.Show (show)

import PostgREST.DbStructure.Identifiers  (FieldName,
                                           QualifiedIdentifier)
import PostgREST.DbStructure.Relationship (Relationship)
import PostgREST.RangeQuery               (NonnegRange)
import PostgREST.Request.Preferences      (PreferResolution)

import Protolude


type ReadRequest = Tree ReadNode
type MutateRequest = MutateQuery

type ReadNode =
  (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe EmbedHint, Depth))

type NodeName = Text
type Depth = Integer

data ReadQuery = Select
  { ReadQuery -> [SelectItem]
select         :: [SelectItem]
  , ReadQuery -> QualifiedIdentifier
from           :: QualifiedIdentifier
  -- ^ A table alias is used in case of self joins
  , ReadQuery -> Maybe Alias
fromAlias      :: Maybe Alias
  -- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins.
  , ReadQuery -> [QualifiedIdentifier]
implicitJoins  :: [QualifiedIdentifier]
  , ReadQuery -> [LogicTree]
where_         :: [LogicTree]
  , ReadQuery -> [JoinCondition]
joinConditions :: [JoinCondition]
  , ReadQuery -> [OrderTerm]
order          :: [OrderTerm]
  , ReadQuery -> NonnegRange
range_         :: NonnegRange
  }
  deriving (ReadQuery -> ReadQuery -> Bool
(ReadQuery -> ReadQuery -> Bool)
-> (ReadQuery -> ReadQuery -> Bool) -> Eq ReadQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadQuery -> ReadQuery -> Bool
$c/= :: ReadQuery -> ReadQuery -> Bool
== :: ReadQuery -> ReadQuery -> Bool
$c== :: ReadQuery -> ReadQuery -> Bool
Eq)

data JoinCondition =
  JoinCondition
    (QualifiedIdentifier, FieldName)
    (QualifiedIdentifier, FieldName)
  deriving (JoinCondition -> JoinCondition -> Bool
(JoinCondition -> JoinCondition -> Bool)
-> (JoinCondition -> JoinCondition -> Bool) -> Eq JoinCondition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoinCondition -> JoinCondition -> Bool
$c/= :: JoinCondition -> JoinCondition -> Bool
== :: JoinCondition -> JoinCondition -> Bool
$c== :: JoinCondition -> JoinCondition -> Bool
Eq)

data OrderTerm = OrderTerm
  { OrderTerm -> Field
otTerm      :: Field
  , OrderTerm -> Maybe OrderDirection
otDirection :: Maybe OrderDirection
  , OrderTerm -> Maybe OrderNulls
otNullOrder :: Maybe OrderNulls
  }
  deriving (OrderTerm -> OrderTerm -> Bool
(OrderTerm -> OrderTerm -> Bool)
-> (OrderTerm -> OrderTerm -> Bool) -> Eq OrderTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderTerm -> OrderTerm -> Bool
$c/= :: OrderTerm -> OrderTerm -> Bool
== :: OrderTerm -> OrderTerm -> Bool
$c== :: OrderTerm -> OrderTerm -> Bool
Eq)

data OrderDirection
  = OrderAsc
  | OrderDesc
  deriving (OrderDirection -> OrderDirection -> Bool
(OrderDirection -> OrderDirection -> Bool)
-> (OrderDirection -> OrderDirection -> Bool) -> Eq OrderDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderDirection -> OrderDirection -> Bool
$c/= :: OrderDirection -> OrderDirection -> Bool
== :: OrderDirection -> OrderDirection -> Bool
$c== :: OrderDirection -> OrderDirection -> Bool
Eq)

instance Show OrderDirection where
  show :: OrderDirection -> String
show OrderDirection
OrderAsc  = String
"ASC"
  show OrderDirection
OrderDesc = String
"DESC"

data OrderNulls
  = OrderNullsFirst
  | OrderNullsLast
  deriving (OrderNulls -> OrderNulls -> Bool
(OrderNulls -> OrderNulls -> Bool)
-> (OrderNulls -> OrderNulls -> Bool) -> Eq OrderNulls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderNulls -> OrderNulls -> Bool
$c/= :: OrderNulls -> OrderNulls -> Bool
== :: OrderNulls -> OrderNulls -> Bool
$c== :: OrderNulls -> OrderNulls -> Bool
Eq)

instance Show OrderNulls where
  show :: OrderNulls -> String
show OrderNulls
OrderNullsFirst = String
"NULLS FIRST"
  show OrderNulls
OrderNullsLast  = String
"NULLS LAST"

data MutateQuery
  = Insert
      { MutateQuery -> QualifiedIdentifier
in_        :: QualifiedIdentifier
      , MutateQuery -> Set Alias
insCols    :: S.Set FieldName
      , MutateQuery -> Maybe ByteString
insBody    :: Maybe BL.ByteString
      , MutateQuery -> Maybe (PreferResolution, [Alias])
onConflict :: Maybe (PreferResolution, [FieldName])
      , MutateQuery -> [LogicTree]
where_     :: [LogicTree]
      , MutateQuery -> [Alias]
returning  :: [FieldName]
      }
  | Update
      { in_       :: QualifiedIdentifier
      , MutateQuery -> Set Alias
updCols   :: S.Set FieldName
      , MutateQuery -> Maybe ByteString
updBody   :: Maybe BL.ByteString
      , where_    :: [LogicTree]
      , returning :: [FieldName]
      }
  | Delete
      { in_       :: QualifiedIdentifier
      , where_    :: [LogicTree]
      , returning :: [FieldName]
      }

-- | The select value in `/tbl?select=alias:field::cast`
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint)

type Field = (FieldName, JsonPath)
type Cast = Text
type Alias = Text

-- | Disambiguates an embedding operation when there's multiple relationships
-- between two tables. Can be the name of a foreign key constraint, column
-- name or the junction in an m2m relationship.
type EmbedHint = Text

-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
-- ["clients", "projects"]
type EmbedPath = [Text]

-- | Json path operations as specified in
-- https://www.postgresql.org/docs/current/static/functions-json.html
type JsonPath = [JsonOperation]

-- | Represents the single arrow `->` or double arrow `->>` operators
data JsonOperation
  = JArrow { JsonOperation -> JsonOperand
jOp :: JsonOperand }
  | J2Arrow { jOp :: JsonOperand }
  deriving (JsonOperation -> JsonOperation -> Bool
(JsonOperation -> JsonOperation -> Bool)
-> (JsonOperation -> JsonOperation -> Bool) -> Eq JsonOperation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonOperation -> JsonOperation -> Bool
$c/= :: JsonOperation -> JsonOperation -> Bool
== :: JsonOperation -> JsonOperation -> Bool
$c== :: JsonOperation -> JsonOperation -> Bool
Eq)

-- | Represents the key(`->'key'`) or index(`->'1`::int`), the index is Text
-- because we reuse our escaping functons and let pg do the casting with
-- '1'::int
data JsonOperand
  = JKey { JsonOperand -> Alias
jVal :: Text }
  | JIdx { jVal :: Text }
  deriving (JsonOperand -> JsonOperand -> Bool
(JsonOperand -> JsonOperand -> Bool)
-> (JsonOperand -> JsonOperand -> Bool) -> Eq JsonOperand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonOperand -> JsonOperand -> Bool
$c/= :: JsonOperand -> JsonOperand -> Bool
== :: JsonOperand -> JsonOperand -> Bool
$c== :: JsonOperand -> JsonOperand -> Bool
Eq)

-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
fstFieldNames :: ReadRequest -> [FieldName]
fstFieldNames :: ReadRequest -> [Alias]
fstFieldNames (Node (ReadQuery
sel, (Alias, Maybe Relationship, Maybe Alias, Maybe Alias, Depth)
_) Forest
  (ReadQuery,
   (Alias, Maybe Relationship, Maybe Alias, Maybe Alias, Depth))
_) =
  Field -> Alias
forall a b. (a, b) -> a
fst (Field -> Alias) -> (SelectItem -> Field) -> SelectItem -> Alias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Field
f, Maybe Alias
_, Maybe Alias
_, Maybe Alias
_) -> Field
f) (SelectItem -> Alias) -> [SelectItem] -> [Alias]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadQuery -> [SelectItem]
select ReadQuery
sel


-- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
--
--            And
--           /   \
--  name.eq.N     Or
--               /  \
--         id.eq.1   id.eq.2
data LogicTree
  = Expr Bool LogicOperator [LogicTree]
  | Stmnt Filter
  deriving (LogicTree -> LogicTree -> Bool
(LogicTree -> LogicTree -> Bool)
-> (LogicTree -> LogicTree -> Bool) -> Eq LogicTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicTree -> LogicTree -> Bool
$c/= :: LogicTree -> LogicTree -> Bool
== :: LogicTree -> LogicTree -> Bool
$c== :: LogicTree -> LogicTree -> Bool
Eq)

data LogicOperator
  = And
  | Or
  deriving LogicOperator -> LogicOperator -> Bool
(LogicOperator -> LogicOperator -> Bool)
-> (LogicOperator -> LogicOperator -> Bool) -> Eq LogicOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicOperator -> LogicOperator -> Bool
$c/= :: LogicOperator -> LogicOperator -> Bool
== :: LogicOperator -> LogicOperator -> Bool
$c== :: LogicOperator -> LogicOperator -> Bool
Eq

instance Show LogicOperator where
  show :: LogicOperator -> String
show LogicOperator
And = String
"AND"
  show LogicOperator
Or  = String
"OR"

data Filter = Filter
  { Filter -> Field
field  :: Field
  , Filter -> OpExpr
opExpr :: OpExpr
  }
  deriving (Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
Eq)

data OpExpr =
  OpExpr Bool Operation
  deriving (OpExpr -> OpExpr -> Bool
(OpExpr -> OpExpr -> Bool)
-> (OpExpr -> OpExpr -> Bool) -> Eq OpExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpExpr -> OpExpr -> Bool
$c/= :: OpExpr -> OpExpr -> Bool
== :: OpExpr -> OpExpr -> Bool
$c== :: OpExpr -> OpExpr -> Bool
Eq)

data Operation
  = Op Operator SingleVal
  | In ListVal
  | Fts Operator (Maybe Language) SingleVal
  deriving (Operation -> Operation -> Bool
(Operation -> Operation -> Bool)
-> (Operation -> Operation -> Bool) -> Eq Operation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c== :: Operation -> Operation -> Bool
Eq)

type Operator = Text
type Language = Text

-- | Represents a single value in a filter, e.g. id=eq.singleval
type SingleVal = Text

-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
type ListVal = [Text]