{-|
Module      : PostgREST.Request.DbRequestBuilder
Description : PostgREST database request builder

This module is in charge of building an intermediate
representation(ReadRequest, MutateRequest) between the HTTP request and the
final resulting SQL query.

A query tree is built in case of resource embedding. By inferring the
relationship between tables, join conditions are added for every embedded
resource.
-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RecordWildCards       #-}

module PostgREST.Request.DbRequestBuilder
  ( readRequest
  , mutateRequest
  , returningCols
  ) where

import qualified Data.HashMap.Strict as M
import qualified Data.Set            as S

import Control.Arrow           ((***))
import Data.Either.Combinators (mapLeft)
import Data.List               (delete)
import Data.Text               (isInfixOf)
import Data.Tree               (Tree (..))

import PostgREST.DbStructure.Identifiers  (FieldName,
                                           QualifiedIdentifier (..),
                                           Schema, TableName)
import PostgREST.DbStructure.Relationship (Cardinality (..),
                                           Junction (..),
                                           Relationship (..))
import PostgREST.DbStructure.Table        (Column (..), Table (..),
                                           tableQi)
import PostgREST.Error                    (ApiRequestError (..),
                                           Error (..))
import PostgREST.Query.SqlFragment        (sourceCTEName)
import PostgREST.RangeQuery               (NonnegRange, allRange,
                                           restrictRange)
import PostgREST.Request.ApiRequest       (Action (..),
                                           ApiRequest (..),
                                           PayloadJSON (..))

import PostgREST.Request.Parsers
import PostgREST.Request.Preferences
import PostgREST.Request.Types

import qualified PostgREST.DbStructure.Relationship as Relationship

import Protolude hiding (from)

-- | Builds the ReadRequest tree on a number of stages.
-- | Adds filters, order, limits on its respective nodes.
-- | Adds joins conditions obtained from resource embedding.
readRequest :: Schema -> TableName -> Maybe Integer -> [Relationship] -> ApiRequest -> Either Error ReadRequest
readRequest :: Schema
-> Schema
-> Maybe Integer
-> [Relationship]
-> ApiRequest
-> Either Error ReadRequest
readRequest Schema
schema Schema
rootTableName Maybe Integer
maxRows [Relationship]
allRels ApiRequest
apiRequest  =
  (ApiRequestError -> Error)
-> Either ApiRequestError ReadRequest -> Either Error ReadRequest
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ApiRequestError -> Error
ApiRequestError (Either ApiRequestError ReadRequest -> Either Error ReadRequest)
-> Either ApiRequestError ReadRequest -> Either Error ReadRequest
forall a b. (a -> b) -> a -> b
$
  Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
treeRestrictRange Maybe Integer
maxRows (ReadRequest -> Either ApiRequestError ReadRequest)
-> Either ApiRequestError ReadRequest
-> Either ApiRequestError ReadRequest
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  Schema
-> [Relationship]
-> ReadRequest
-> Either ApiRequestError ReadRequest
augmentRequestWithJoin Schema
schema [Relationship]
rootRels (ReadRequest -> Either ApiRequestError ReadRequest)
-> Either ApiRequestError ReadRequest
-> Either ApiRequestError ReadRequest
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  (ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addFiltersOrdersRanges ApiRequest
apiRequest (ReadRequest -> Either ApiRequestError ReadRequest)
-> ([Tree SelectItem] -> ReadRequest)
-> [Tree SelectItem]
-> Either ApiRequestError ReadRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
initReadRequest QualifiedIdentifier
rootName ([Tree SelectItem] -> Either ApiRequestError ReadRequest)
-> Either ApiRequestError [Tree SelectItem]
-> Either ApiRequestError ReadRequest
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Schema -> Either ApiRequestError [Tree SelectItem]
pRequestSelect Schema
sel)
  where
    sel :: Schema
sel = Schema -> Maybe Schema -> Schema
forall a. a -> Maybe a -> a
fromMaybe Schema
"*" (Maybe Schema -> Schema) -> Maybe Schema -> Schema
forall a b. (a -> b) -> a -> b
$ ApiRequest -> Maybe Schema
iSelect ApiRequest
apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
    (QualifiedIdentifier
rootName, [Relationship]
rootRels) = Schema
-> Schema
-> [Relationship]
-> Action
-> (QualifiedIdentifier, [Relationship])
rootWithRels Schema
schema Schema
rootTableName [Relationship]
allRels (ApiRequest -> Action
iAction ApiRequest
apiRequest)

-- Get the root table name with its relationships according to the Action type.
-- This is done because of the shape of the final SQL Query. The mutation cases
-- are wrapped in a WITH {sourceCTEName}(see Statements.hs).  So we need a FROM
-- {sourceCTEName} instead of FROM {tableName}.
rootWithRels :: Schema -> TableName -> [Relationship] -> Action -> (QualifiedIdentifier, [Relationship])
rootWithRels :: Schema
-> Schema
-> [Relationship]
-> Action
-> (QualifiedIdentifier, [Relationship])
rootWithRels Schema
schema Schema
rootTableName [Relationship]
allRels Action
action = case Action
action of
  ActionRead Bool
_ -> (Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier Schema
schema Schema
rootTableName, [Relationship]
allRels) -- normal read case
  Action
_            -> (Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier Schema
forall a. Monoid a => a
mempty Schema
_sourceCTEName, (Relationship -> Maybe Relationship)
-> [Relationship] -> [Relationship]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Relationship -> Maybe Relationship
toSourceRel [Relationship]
allRels [Relationship] -> [Relationship] -> [Relationship]
forall a. [a] -> [a] -> [a]
++ [Relationship]
allRels) -- mutation cases and calling proc
  where
    _sourceCTEName :: Schema
_sourceCTEName = ByteString -> Schema
decodeUtf8 ByteString
sourceCTEName
    -- To enable embedding in the sourceCTEName cases we need to replace the
    -- foreign key tableName in the Relationship with {sourceCTEName}. This way
    -- findRel can find relationships with sourceCTEName.
    toSourceRel :: Relationship -> Maybe Relationship
    toSourceRel :: Relationship -> Maybe Relationship
toSourceRel r :: Relationship
r@Relationship{relTable :: Relationship -> Table
relTable=Table
t}
      | Schema
rootTableName Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Table -> Schema
tableName Table
t = Relationship -> Maybe Relationship
forall a. a -> Maybe a
Just (Relationship -> Maybe Relationship)
-> Relationship -> Maybe Relationship
forall a b. (a -> b) -> a -> b
$ Relationship
r {relTable :: Table
relTable=Table
t {tableName :: Schema
tableName=Schema
_sourceCTEName}}
      | Bool
otherwise                    = Maybe Relationship
forall a. Maybe a
Nothing

-- Build the initial tree with a Depth attribute so when a self join occurs we
-- can differentiate the parent and child tables by having an alias like
-- "table_depth", this is related to
-- http://github.com/PostgREST/postgrest/issues/987.
initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
initReadRequest QualifiedIdentifier
rootQi =
  (Tree SelectItem -> ReadRequest -> ReadRequest)
-> ReadRequest -> [Tree SelectItem] -> ReadRequest
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Integer -> Tree SelectItem -> ReadRequest -> ReadRequest
treeEntry Integer
rootDepth) ReadRequest
forall a a a.
Tree (ReadQuery, (Schema, Maybe a, Maybe a, Maybe a, Integer))
initial
  where
    rootDepth :: Integer
rootDepth = Integer
0
    rootSchema :: Schema
rootSchema = QualifiedIdentifier -> Schema
qiSchema QualifiedIdentifier
rootQi
    rootName :: Schema
rootName = QualifiedIdentifier -> Schema
qiName QualifiedIdentifier
rootQi
    initial :: Tree (ReadQuery, (Schema, Maybe a, Maybe a, Maybe a, Integer))
initial = (ReadQuery, (Schema, Maybe a, Maybe a, Maybe a, Integer))
-> Forest (ReadQuery, (Schema, Maybe a, Maybe a, Maybe a, Integer))
-> Tree (ReadQuery, (Schema, Maybe a, Maybe a, Maybe a, Integer))
forall a. a -> Forest a -> Tree a
Node ([SelectItem]
-> QualifiedIdentifier
-> Maybe Schema
-> [QualifiedIdentifier]
-> [LogicTree]
-> [JoinCondition]
-> [OrderTerm]
-> NonnegRange
-> ReadQuery
Select [] QualifiedIdentifier
rootQi Maybe Schema
forall a. Maybe a
Nothing [] [] [] [] NonnegRange
allRange, (Schema
rootName, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing, Integer
rootDepth)) []
    treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
    treeEntry :: Integer -> Tree SelectItem -> ReadRequest -> ReadRequest
treeEntry Integer
depth (Node fld :: SelectItem
fld@((Schema
fn, JsonPath
_),Maybe Schema
_,Maybe Schema
alias, Maybe Schema
embedHint) [Tree SelectItem]
fldForest) (Node (ReadQuery
q, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
rForest) =
      let nxtDepth :: Integer
nxtDepth = Integer -> Integer
forall a. Enum a => a -> a
succ Integer
depth in
      case [Tree SelectItem]
fldForest of
        [] -> (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery
q {$sel:select:Select :: [SelectItem]
select=SelectItem
fldSelectItem -> [SelectItem] -> [SelectItem]
forall a. a -> [a] -> [a]
:ReadQuery -> [SelectItem]
select ReadQuery
q}, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
rForest
        [Tree SelectItem]
_  -> (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery
q, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) (Forest
   (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> ReadRequest)
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a b. (a -> b) -> a -> b
$
              (Tree SelectItem -> ReadRequest -> ReadRequest)
-> ReadRequest -> [Tree SelectItem] -> ReadRequest
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Integer -> Tree SelectItem -> ReadRequest -> ReadRequest
treeEntry Integer
nxtDepth)
              ((ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node ([SelectItem]
-> QualifiedIdentifier
-> Maybe Schema
-> [QualifiedIdentifier]
-> [LogicTree]
-> [JoinCondition]
-> [OrderTerm]
-> NonnegRange
-> ReadQuery
Select [] (Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier Schema
rootSchema Schema
fn) Maybe Schema
forall a. Maybe a
Nothing [] [] [] [] NonnegRange
allRange,
                (Schema
fn, Maybe Relationship
forall a. Maybe a
Nothing, Maybe Schema
alias, Maybe Schema
embedHint, Integer
nxtDepth)) [])
              [Tree SelectItem]
fldForestReadRequest
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forall a. a -> [a] -> [a]
:Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
rForest

-- | Enforces the `max-rows` config on the result
treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
treeRestrictRange Maybe Integer
maxRows ReadRequest
request = ReadRequest -> Either ApiRequestError ReadRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadRequest -> Either ApiRequestError ReadRequest)
-> ReadRequest -> Either ApiRequestError ReadRequest
forall a b. (a -> b) -> a -> b
$ Maybe Integer
-> (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
nodeRestrictRange Maybe Integer
maxRows ((ReadQuery,
  (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> (ReadQuery,
     (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
-> ReadRequest -> ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadRequest
request
  where
    nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
    nodeRestrictRange :: Maybe Integer
-> (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
nodeRestrictRange Maybe Integer
m (q :: ReadQuery
q@Select {$sel:range_:Select :: ReadQuery -> NonnegRange
range_=NonnegRange
r}, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) = (ReadQuery
q{$sel:range_:Select :: NonnegRange
range_=Maybe Integer -> NonnegRange -> NonnegRange
restrictRange Maybe Integer
m NonnegRange
r }, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i)

augmentRequestWithJoin :: Schema -> [Relationship] -> ReadRequest -> Either ApiRequestError ReadRequest
augmentRequestWithJoin :: Schema
-> [Relationship]
-> ReadRequest
-> Either ApiRequestError ReadRequest
augmentRequestWithJoin Schema
schema [Relationship]
allRels ReadRequest
request =
  Schema
-> [Relationship]
-> Maybe ReadRequest
-> ReadRequest
-> Either ApiRequestError ReadRequest
addRels Schema
schema [Relationship]
allRels Maybe ReadRequest
forall a. Maybe a
Nothing ReadRequest
request
  Either ApiRequestError ReadRequest
-> (ReadRequest -> Either ApiRequestError ReadRequest)
-> Either ApiRequestError ReadRequest
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Schema -> ReadRequest -> Either ApiRequestError ReadRequest
addJoinConditions Maybe Schema
forall a. Maybe a
Nothing

addRels :: Schema -> [Relationship] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addRels :: Schema
-> [Relationship]
-> Maybe ReadRequest
-> ReadRequest
-> Either ApiRequestError ReadRequest
addRels Schema
schema [Relationship]
allRels Maybe ReadRequest
parentNode (Node (query :: ReadQuery
query@Select{$sel:from:Select :: ReadQuery -> QualifiedIdentifier
from=QualifiedIdentifier
tbl}, (Schema
nodeName, Maybe Relationship
_, Maybe Schema
alias, Maybe Schema
hint, Integer
depth)) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest) =
  case Maybe ReadRequest
parentNode of
    Just (Node (Select{$sel:from:Select :: ReadQuery -> QualifiedIdentifier
from=QualifiedIdentifier
parentNodeQi}, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
_) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
_) ->
      let newFrom :: Relationship -> QualifiedIdentifier
newFrom Relationship
r = if QualifiedIdentifier -> Schema
qiName QualifiedIdentifier
tbl Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
nodeName then Table -> QualifiedIdentifier
tableQi (Relationship -> Table
relForeignTable Relationship
r) else QualifiedIdentifier
tbl
          newReadNode :: Either
  ApiRequestError
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe a, Integer))
newReadNode = (\Relationship
r -> (ReadQuery
query{$sel:from:Select :: QualifiedIdentifier
from=Relationship -> QualifiedIdentifier
newFrom Relationship
r}, (Schema
nodeName, Relationship -> Maybe Relationship
forall a. a -> Maybe a
Just Relationship
r, Maybe Schema
alias, Maybe a
forall a. Maybe a
Nothing, Integer
depth))) (Relationship
 -> (ReadQuery,
     (Schema, Maybe Relationship, Maybe Schema, Maybe a, Integer)))
-> Either ApiRequestError Relationship
-> Either
     ApiRequestError
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe a, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError Relationship
rel
          rel :: Either ApiRequestError Relationship
rel = Schema
-> [Relationship]
-> Schema
-> Schema
-> Maybe Schema
-> Either ApiRequestError Relationship
findRel Schema
schema [Relationship]
allRels (QualifiedIdentifier -> Schema
qiName QualifiedIdentifier
parentNodeQi) Schema
nodeName Maybe Schema
hint
      in
      (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node ((ReadQuery,
  (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> Forest
      (ReadQuery,
       (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> ReadRequest)
-> Either
     ApiRequestError
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
      -> ReadRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  ApiRequestError
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forall a.
Either
  ApiRequestError
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe a, Integer))
newReadNode Either
  ApiRequestError
  (Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
   -> ReadRequest)
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe ReadRequest
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
updateForest (Maybe ReadRequest
 -> Either
      ApiRequestError
      (Forest
         (ReadQuery,
          (Schema, Maybe Relationship, Maybe Schema, Maybe Schema,
           Integer))))
-> (Either ApiRequestError ReadRequest -> Maybe ReadRequest)
-> Either ApiRequestError ReadRequest
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ApiRequestError ReadRequest -> Maybe ReadRequest
forall (m :: * -> *) e a. Alternative m => Either e a -> m a
hush (Either ApiRequestError ReadRequest
 -> Either
      ApiRequestError
      (Forest
         (ReadQuery,
          (Schema, Maybe Relationship, Maybe Schema, Maybe Schema,
           Integer))))
-> Either ApiRequestError ReadRequest
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
forall a b. (a -> b) -> a -> b
$ (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node ((ReadQuery,
  (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> Forest
      (ReadQuery,
       (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> ReadRequest)
-> Either
     ApiRequestError
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
      -> ReadRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  ApiRequestError
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forall a.
Either
  ApiRequestError
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe a, Integer))
newReadNode Either
  ApiRequestError
  (Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
   -> ReadRequest)
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest)
    Maybe ReadRequest
_ ->
      let rn :: (ReadQuery, (Schema, Maybe a, Maybe Schema, Maybe a, Integer))
rn = (ReadQuery
query, (Schema
nodeName, Maybe a
forall a. Maybe a
Nothing, Maybe Schema
alias, Maybe a
forall a. Maybe a
Nothing, Integer
depth)) in
      (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forall a a.
(ReadQuery, (Schema, Maybe a, Maybe Schema, Maybe a, Integer))
rn (Forest
   (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> ReadRequest)
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ReadRequest
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
updateForest (ReadRequest -> Maybe ReadRequest
forall a. a -> Maybe a
Just (ReadRequest -> Maybe ReadRequest)
-> ReadRequest -> Maybe ReadRequest
forall a b. (a -> b) -> a -> b
$ (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forall a a.
(ReadQuery, (Schema, Maybe a, Maybe Schema, Maybe a, Integer))
rn Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest)
  where
    updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
    updateForest :: Maybe ReadRequest
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
updateForest Maybe ReadRequest
rq = Schema
-> [Relationship]
-> Maybe ReadRequest
-> ReadRequest
-> Either ApiRequestError ReadRequest
addRels Schema
schema [Relationship]
allRels Maybe ReadRequest
rq (ReadRequest -> Either ApiRequestError ReadRequest)
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest

-- Finds a relationship between an origin and a target in the request:
-- /origin?select=target(*) If more than one relationship is found then the
-- request is ambiguous and we return an error.  In that case the request can
-- be disambiguated by adding precision to the target or by using a hint:
-- /origin?select=target!hint(*) The elements will be matched according to
-- these rules:
-- origin = table / view
-- target = table / view / constraint / column-from-origin
-- hint   = table / view / constraint / column-from-origin / column-from-target
-- (hint can take table / view values to aid in finding the junction in an m2m relationship)
findRel :: Schema -> [Relationship] -> NodeName -> NodeName -> Maybe EmbedHint -> Either ApiRequestError Relationship
findRel :: Schema
-> [Relationship]
-> Schema
-> Schema
-> Maybe Schema
-> Either ApiRequestError Relationship
findRel Schema
schema [Relationship]
allRels Schema
origin Schema
target Maybe Schema
hint =
  case [Relationship]
rel of
    []  -> ApiRequestError -> Either ApiRequestError Relationship
forall a b. a -> Either a b
Left (ApiRequestError -> Either ApiRequestError Relationship)
-> ApiRequestError -> Either ApiRequestError Relationship
forall a b. (a -> b) -> a -> b
$ Schema -> Schema -> ApiRequestError
NoRelBetween Schema
origin Schema
target
    [Relationship
r] -> Relationship -> Either ApiRequestError Relationship
forall a b. b -> Either a b
Right Relationship
r
    -- Here we handle a self reference relationship to not cause a breaking
    -- change: In a self reference we get two relationships with the same
    -- foreign key and relTable/relFtable but with different
    -- cardinalities(m2o/o2m) We output the O2M rel, the M2O rel can be
    -- obtained by using the origin column as an embed hint.
    rs :: [Relationship]
rs@[Relationship
rel0, Relationship
rel1]  -> case (Relationship -> Cardinality
relCardinality Relationship
rel0, Relationship -> Cardinality
relCardinality Relationship
rel1, Relationship -> Table
relTable Relationship
rel0 Table -> Table -> Bool
forall a. Eq a => a -> a -> Bool
== Relationship -> Table
relTable Relationship
rel1 Bool -> Bool -> Bool
&& Relationship -> Table
relForeignTable Relationship
rel0 Table -> Table -> Bool
forall a. Eq a => a -> a -> Bool
== Relationship -> Table
relForeignTable Relationship
rel1) of
      (O2M Schema
cons1, M2O Schema
cons2, Bool
True) -> if Schema
cons1 Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
cons2 then Relationship -> Either ApiRequestError Relationship
forall a b. b -> Either a b
Right Relationship
rel0 else ApiRequestError -> Either ApiRequestError Relationship
forall a b. a -> Either a b
Left (ApiRequestError -> Either ApiRequestError Relationship)
-> ApiRequestError -> Either ApiRequestError Relationship
forall a b. (a -> b) -> a -> b
$ Schema -> Schema -> [Relationship] -> ApiRequestError
AmbiguousRelBetween Schema
origin Schema
target [Relationship]
rs
      (M2O Schema
cons1, O2M Schema
cons2, Bool
True) -> if Schema
cons1 Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
cons2 then Relationship -> Either ApiRequestError Relationship
forall a b. b -> Either a b
Right Relationship
rel1 else ApiRequestError -> Either ApiRequestError Relationship
forall a b. a -> Either a b
Left (ApiRequestError -> Either ApiRequestError Relationship)
-> ApiRequestError -> Either ApiRequestError Relationship
forall a b. (a -> b) -> a -> b
$ Schema -> Schema -> [Relationship] -> ApiRequestError
AmbiguousRelBetween Schema
origin Schema
target [Relationship]
rs
      (Cardinality, Cardinality, Bool)
_                            -> ApiRequestError -> Either ApiRequestError Relationship
forall a b. a -> Either a b
Left (ApiRequestError -> Either ApiRequestError Relationship)
-> ApiRequestError -> Either ApiRequestError Relationship
forall a b. (a -> b) -> a -> b
$ Schema -> Schema -> [Relationship] -> ApiRequestError
AmbiguousRelBetween Schema
origin Schema
target [Relationship]
rs
    [Relationship]
rs -> ApiRequestError -> Either ApiRequestError Relationship
forall a b. a -> Either a b
Left (ApiRequestError -> Either ApiRequestError Relationship)
-> ApiRequestError -> Either ApiRequestError Relationship
forall a b. (a -> b) -> a -> b
$ Schema -> Schema -> [Relationship] -> ApiRequestError
AmbiguousRelBetween Schema
origin Schema
target [Relationship]
rs
  where
    matchFKSingleCol :: Maybe Schema -> f Column -> Bool
matchFKSingleCol Maybe Schema
hint_ f Column
cols = f Column -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f Column
cols Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Maybe Schema
hint_ Maybe Schema -> Maybe Schema -> Bool
forall a. Eq a => a -> a -> Bool
== (Column -> Schema
colName (Column -> Schema) -> Maybe Column -> Maybe Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Column -> Maybe Column
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head f Column
cols)
    matchConstraint :: Maybe Schema -> Cardinality -> Bool
matchConstraint Maybe Schema
tar Cardinality
card = case Cardinality
card of
      O2M Schema
cons -> Maybe Schema
tar Maybe Schema -> Maybe Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
cons
      M2O Schema
cons -> Maybe Schema
tar Maybe Schema -> Maybe Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
cons
      Cardinality
_        -> Bool
False
    matchJunction :: Maybe Schema -> Cardinality -> Bool
matchJunction Maybe Schema
hint_ Cardinality
card = case Cardinality
card of
      M2M Junction{Table
junTable :: Junction -> Table
junTable :: Table
junTable} -> Maybe Schema
hint_ Maybe Schema -> Maybe Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema -> Maybe Schema
forall a. a -> Maybe a
Just (Table -> Schema
tableName Table
junTable)
      Cardinality
_                      -> Bool
False
    rel :: [Relationship]
rel = (Relationship -> Bool) -> [Relationship] -> [Relationship]
forall a. (a -> Bool) -> [a] -> [a]
filter (
      \Relationship{[Column]
Table
Cardinality
relForeignColumns :: Relationship -> [Column]
relColumns :: Relationship -> [Column]
relCardinality :: Cardinality
relForeignColumns :: [Column]
relForeignTable :: Table
relColumns :: [Column]
relTable :: Table
relCardinality :: Relationship -> Cardinality
relForeignTable :: Relationship -> Table
relTable :: Relationship -> Table
..} ->
        -- Both relationship ends need to be on the exposed schema
        Schema
schema Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Table -> Schema
tableSchema Table
relTable Bool -> Bool -> Bool
&& Schema
schema Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Table -> Schema
tableSchema Table
relForeignTable Bool -> Bool -> Bool
&&
        (
          -- /projects?select=clients(*)
          Schema
origin Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Table -> Schema
tableName Table
relTable  Bool -> Bool -> Bool
&&  -- projects
          Schema
target Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Table -> Schema
tableName Table
relForeignTable Bool -> Bool -> Bool
||  -- clients

          -- /projects?select=projects_client_id_fkey(*)
          (
            Schema
origin Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Table -> Schema
tableName Table
relTable Bool -> Bool -> Bool
&&              -- projects
            Maybe Schema -> Cardinality -> Bool
matchConstraint (Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
target) Cardinality
relCardinality -- projects_client_id_fkey
          ) Bool -> Bool -> Bool
||
          -- /projects?select=client_id(*)
          (
            Schema
origin Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Table -> Schema
tableName Table
relTable Bool -> Bool -> Bool
&&           -- projects
            Maybe Schema -> [Column] -> Bool
forall (f :: * -> *).
Foldable f =>
Maybe Schema -> f Column -> Bool
matchFKSingleCol (Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
target) [Column]
relColumns -- client_id
          )
        ) Bool -> Bool -> Bool
&& (
          Maybe Schema -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Schema
hint Bool -> Bool -> Bool
|| -- hint is optional

          -- /projects?select=clients!projects_client_id_fkey(*)
          Maybe Schema -> Cardinality -> Bool
matchConstraint Maybe Schema
hint Cardinality
relCardinality Bool -> Bool -> Bool
|| -- projects_client_id_fkey

          -- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
          Maybe Schema -> [Column] -> Bool
forall (f :: * -> *).
Foldable f =>
Maybe Schema -> f Column -> Bool
matchFKSingleCol Maybe Schema
hint [Column]
relColumns  Bool -> Bool -> Bool
|| -- client_id
          Maybe Schema -> [Column] -> Bool
forall (f :: * -> *).
Foldable f =>
Maybe Schema -> f Column -> Bool
matchFKSingleCol Maybe Schema
hint [Column]
relForeignColumns Bool -> Bool -> Bool
|| -- id

          -- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
          Maybe Schema -> Cardinality -> Bool
matchJunction Maybe Schema
hint Cardinality
relCardinality -- users_tasks
        )
      ) [Relationship]
allRels

-- previousAlias is only used for the case of self joins
addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
addJoinConditions :: Maybe Schema -> ReadRequest -> Either ApiRequestError ReadRequest
addJoinConditions Maybe Schema
previousAlias (Node node :: (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
node@(query :: ReadQuery
query@Select{$sel:from:Select :: ReadQuery -> QualifiedIdentifier
from=QualifiedIdentifier
tbl}, nodeProps :: (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
nodeProps@(Schema
_, Maybe Relationship
rel, Maybe Schema
_, Maybe Schema
_, Integer
depth)) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest) =
  case Maybe Relationship
rel of
    Just r :: Relationship
r@Relationship{relCardinality :: Relationship -> Cardinality
relCardinality=M2M Junction{Table
junTable :: Table
junTable :: Junction -> Table
junTable}} ->
      let rq :: ReadQuery
rq = Relationship -> ReadQuery
augmentQuery Relationship
r in
      (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery
rq{$sel:implicitJoins:Select :: [QualifiedIdentifier]
implicitJoins=Table -> QualifiedIdentifier
tableQi Table
junTableQualifiedIdentifier
-> [QualifiedIdentifier] -> [QualifiedIdentifier]
forall a. a -> [a] -> [a]
:ReadQuery -> [QualifiedIdentifier]
implicitJoins ReadQuery
rq}, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
nodeProps) (Forest
   (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> ReadRequest)
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  ApiRequestError
  (Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
updatedForest
    Just Relationship
r -> (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (Relationship -> ReadQuery
augmentQuery Relationship
r, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
nodeProps) (Forest
   (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> ReadRequest)
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  ApiRequestError
  (Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
updatedForest
    Maybe Relationship
Nothing -> (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
node (Forest
   (ReadQuery,
    (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
 -> ReadRequest)
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  ApiRequestError
  (Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
updatedForest
  where
    newAlias :: Maybe Schema
newAlias = case Relationship -> Bool
Relationship.isSelfReference (Relationship -> Bool) -> Maybe Relationship -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Relationship
rel of
      Just Bool
True
        | Integer
depth Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 -> Schema -> Maybe Schema
forall a. a -> Maybe a
Just (QualifiedIdentifier -> Schema
qiName QualifiedIdentifier
tbl Schema -> Schema -> Schema
forall a. Semigroup a => a -> a -> a
<> Schema
"_" Schema -> Schema -> Schema
forall a. Semigroup a => a -> a -> a
<> Integer -> Schema
forall a b. (Show a, ConvertText String b) => a -> b
show Integer
depth) -- root node doesn't get aliased
        | Bool
otherwise  -> Maybe Schema
forall a. Maybe a
Nothing
      Maybe Bool
_              -> Maybe Schema
forall a. Maybe a
Nothing
    augmentQuery :: Relationship -> ReadQuery
augmentQuery Relationship
r =
      (JoinCondition -> ReadQuery -> ReadQuery)
-> ReadQuery -> [JoinCondition] -> ReadQuery
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        (\JoinCondition
jc rq :: ReadQuery
rq@Select{$sel:joinConditions:Select :: ReadQuery -> [JoinCondition]
joinConditions=[JoinCondition]
jcs} -> ReadQuery
rq{$sel:joinConditions:Select :: [JoinCondition]
joinConditions=JoinCondition
jcJoinCondition -> [JoinCondition] -> [JoinCondition]
forall a. a -> [a] -> [a]
:[JoinCondition]
jcs})
        ReadQuery
query{$sel:fromAlias:Select :: Maybe Schema
fromAlias=Maybe Schema
newAlias}
        (Maybe Schema -> Maybe Schema -> Relationship -> [JoinCondition]
getJoinConditions Maybe Schema
previousAlias Maybe Schema
newAlias Relationship
r)
    updatedForest :: Either
  ApiRequestError
  (Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
updatedForest = Maybe Schema -> ReadRequest -> Either ApiRequestError ReadRequest
addJoinConditions Maybe Schema
newAlias (ReadRequest -> Either ApiRequestError ReadRequest)
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Either
     ApiRequestError
     (Forest
        (ReadQuery,
         (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest

-- previousAlias and newAlias are used in the case of self joins
getJoinConditions :: Maybe Alias -> Maybe Alias -> Relationship -> [JoinCondition]
getJoinConditions :: Maybe Schema -> Maybe Schema -> Relationship -> [JoinCondition]
getJoinConditions Maybe Schema
previousAlias Maybe Schema
newAlias (Relationship Table{tableSchema :: Table -> Schema
tableSchema=Schema
tSchema, tableName :: Table -> Schema
tableName=Schema
tN} [Column]
cols Table{tableName :: Table -> Schema
tableName=Schema
ftN} [Column]
fCols Cardinality
card) =
  case Cardinality
card of
    M2M (Junction Table{tableName :: Table -> Schema
tableName=Schema
jtn} Schema
_ [Column]
jc1 Schema
_ [Column]
jc2) ->
      (Column -> Column -> JoinCondition)
-> [Column] -> [Column] -> [JoinCondition]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Schema -> Schema -> Column -> Column -> JoinCondition
toJoinCondition Schema
tN Schema
jtn) [Column]
cols [Column]
jc1 [JoinCondition] -> [JoinCondition] -> [JoinCondition]
forall a. [a] -> [a] -> [a]
++ (Column -> Column -> JoinCondition)
-> [Column] -> [Column] -> [JoinCondition]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Schema -> Schema -> Column -> Column -> JoinCondition
toJoinCondition Schema
ftN Schema
jtn) [Column]
fCols [Column]
jc2
    Cardinality
_ ->
      (Column -> Column -> JoinCondition)
-> [Column] -> [Column] -> [JoinCondition]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Schema -> Schema -> Column -> Column -> JoinCondition
toJoinCondition Schema
tN Schema
ftN) [Column]
cols [Column]
fCols
  where
    toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
    toJoinCondition :: Schema -> Schema -> Column -> Column -> JoinCondition
toJoinCondition Schema
tb Schema
ftb Column
c Column
fc =
      let qi1 :: QualifiedIdentifier
qi1 = Schema -> Schema -> QualifiedIdentifier
removeSourceCTESchema Schema
tSchema Schema
tb
          qi2 :: QualifiedIdentifier
qi2 = Schema -> Schema -> QualifiedIdentifier
removeSourceCTESchema Schema
tSchema Schema
ftb in
        (QualifiedIdentifier, Schema)
-> (QualifiedIdentifier, Schema) -> JoinCondition
JoinCondition (QualifiedIdentifier
-> (Schema -> QualifiedIdentifier)
-> Maybe Schema
-> QualifiedIdentifier
forall b a. b -> (a -> b) -> Maybe a -> b
maybe QualifiedIdentifier
qi1 (Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier Schema
forall a. Monoid a => a
mempty) Maybe Schema
previousAlias, Column -> Schema
colName Column
c)
                      (QualifiedIdentifier
-> (Schema -> QualifiedIdentifier)
-> Maybe Schema
-> QualifiedIdentifier
forall b a. b -> (a -> b) -> Maybe a -> b
maybe QualifiedIdentifier
qi2 (Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier Schema
forall a. Monoid a => a
mempty) Maybe Schema
newAlias, Column -> Schema
colName Column
fc)

    -- On mutation and calling proc cases we wrap the target table in a WITH
    -- {sourceCTEName} if this happens remove the schema `FROM
    -- "schema"."{sourceCTEName}"` and use only the `FROM "{sourceCTEName}"`.
    -- If the schema remains the FROM would be invalid.
    removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
    removeSourceCTESchema :: Schema -> Schema -> QualifiedIdentifier
removeSourceCTESchema Schema
schema Schema
tbl = Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier (if Schema
tbl Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Schema
decodeUtf8 ByteString
sourceCTEName then Schema
forall a. Monoid a => a
mempty else Schema
schema) Schema
tbl

addFiltersOrdersRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addFiltersOrdersRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addFiltersOrdersRanges ApiRequest
apiRequest ReadRequest
rReq = do
  ReadRequest
rFlts <- ((EmbedPath, Filter) -> ReadRequest -> ReadRequest)
-> ReadRequest -> [(EmbedPath, Filter)] -> ReadRequest
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (EmbedPath, Filter) -> ReadRequest -> ReadRequest
addFilter ReadRequest
rReq ([(EmbedPath, Filter)] -> ReadRequest)
-> Either ApiRequestError [(EmbedPath, Filter)]
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError [(EmbedPath, Filter)]
filters
  ReadRequest
rOrds <- ((EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest)
-> ReadRequest -> [(EmbedPath, [OrderTerm])] -> ReadRequest
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
addOrder ReadRequest
rFlts ([(EmbedPath, [OrderTerm])] -> ReadRequest)
-> Either ApiRequestError [(EmbedPath, [OrderTerm])]
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError [(EmbedPath, [OrderTerm])]
orders
  ReadRequest
rRngs <- ((EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest)
-> ReadRequest -> [(EmbedPath, NonnegRange)] -> ReadRequest
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
addRange ReadRequest
rOrds ([(EmbedPath, NonnegRange)] -> ReadRequest)
-> Either ApiRequestError [(EmbedPath, NonnegRange)]
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError [(EmbedPath, NonnegRange)]
ranges
  ((EmbedPath, LogicTree) -> ReadRequest -> ReadRequest)
-> ReadRequest -> [(EmbedPath, LogicTree)] -> ReadRequest
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
addLogicTree ReadRequest
rRngs      ([(EmbedPath, LogicTree)] -> ReadRequest)
-> Either ApiRequestError [(EmbedPath, LogicTree)]
-> Either ApiRequestError ReadRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError [(EmbedPath, LogicTree)]
logicForest
  where
    filters :: Either ApiRequestError [(EmbedPath, Filter)]
    filters :: Either ApiRequestError [(EmbedPath, Filter)]
filters = (Schema, Schema) -> Either ApiRequestError (EmbedPath, Filter)
pRequestFilter ((Schema, Schema) -> Either ApiRequestError (EmbedPath, Filter))
-> [(Schema, Schema)]
-> Either ApiRequestError [(EmbedPath, Filter)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [(Schema, Schema)]
flts
    orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
    orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
orders = (Schema, Schema) -> Either ApiRequestError (EmbedPath, [OrderTerm])
pRequestOrder ((Schema, Schema)
 -> Either ApiRequestError (EmbedPath, [OrderTerm]))
-> [(Schema, Schema)]
-> Either ApiRequestError [(EmbedPath, [OrderTerm])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` ApiRequest -> [(Schema, Schema)]
iOrder ApiRequest
apiRequest
    ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
    ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
ranges = (ByteString, NonnegRange)
-> Either ApiRequestError (EmbedPath, NonnegRange)
pRequestRange ((ByteString, NonnegRange)
 -> Either ApiRequestError (EmbedPath, NonnegRange))
-> [(ByteString, NonnegRange)]
-> Either ApiRequestError [(EmbedPath, NonnegRange)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` HashMap ByteString NonnegRange -> [(ByteString, NonnegRange)]
forall k v. HashMap k v -> [(k, v)]
M.toList (ApiRequest -> HashMap ByteString NonnegRange
iRange ApiRequest
apiRequest)
    logicForest :: Either ApiRequestError [(EmbedPath, LogicTree)]
    logicForest :: Either ApiRequestError [(EmbedPath, LogicTree)]
logicForest = (Schema, Schema) -> Either ApiRequestError (EmbedPath, LogicTree)
pRequestLogicTree ((Schema, Schema) -> Either ApiRequestError (EmbedPath, LogicTree))
-> [(Schema, Schema)]
-> Either ApiRequestError [(EmbedPath, LogicTree)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [(Schema, Schema)]
logFrst
    action :: Action
action = ApiRequest -> Action
iAction ApiRequest
apiRequest
    -- there can be no filters on the root table when we are doing insert/update/delete
    ([(Schema, Schema)]
flts, [(Schema, Schema)]
logFrst) =
      case Action
action of
        ActionInvoke InvokeMethod
_ -> (ApiRequest -> [(Schema, Schema)]
iFilters ApiRequest
apiRequest, ApiRequest -> [(Schema, Schema)]
iLogic ApiRequest
apiRequest)
        ActionRead Bool
_   -> (ApiRequest -> [(Schema, Schema)]
iFilters ApiRequest
apiRequest, ApiRequest -> [(Schema, Schema)]
iLogic ApiRequest
apiRequest)
        Action
_              -> (([(Schema, Schema)] -> [(Schema, Schema)])
 -> ([(Schema, Schema)] -> [(Schema, Schema)])
 -> ([(Schema, Schema)], [(Schema, Schema)])
 -> ([(Schema, Schema)], [(Schema, Schema)]))
-> ([(Schema, Schema)] -> [(Schema, Schema)])
-> ([(Schema, Schema)], [(Schema, Schema)])
-> ([(Schema, Schema)], [(Schema, Schema)])
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([(Schema, Schema)] -> [(Schema, Schema)])
-> ([(Schema, Schema)] -> [(Schema, Schema)])
-> ([(Schema, Schema)], [(Schema, Schema)])
-> ([(Schema, Schema)], [(Schema, Schema)])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) (((Schema, Schema) -> Bool)
-> [(Schema, Schema)] -> [(Schema, Schema)]
forall a. (a -> Bool) -> [a] -> [a]
filter (( Schema
"." Schema -> Schema -> Bool
`isInfixOf` ) (Schema -> Bool)
-> ((Schema, Schema) -> Schema) -> (Schema, Schema) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema, Schema) -> Schema
forall a b. (a, b) -> a
fst)) (ApiRequest -> [(Schema, Schema)]
iFilters ApiRequest
apiRequest, ApiRequest -> [(Schema, Schema)]
iLogic ApiRequest
apiRequest)

addFilterToNode :: Filter -> ReadRequest -> ReadRequest
addFilterToNode :: Filter -> ReadRequest -> ReadRequest
addFilterToNode Filter
flt (Node (q :: ReadQuery
q@Select {$sel:where_:Select :: ReadQuery -> [LogicTree]
where_=[LogicTree]
lf}, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
f) = (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery
q{$sel:where_:Select :: [LogicTree]
where_=Filter -> [LogicTree] -> [LogicTree]
addFilterToLogicForest Filter
flt [LogicTree]
lf}::ReadQuery, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
f

addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
addFilter = (Filter -> ReadRequest -> ReadRequest)
-> (EmbedPath, Filter) -> ReadRequest -> ReadRequest
forall a.
(a -> ReadRequest -> ReadRequest)
-> (EmbedPath, a) -> ReadRequest -> ReadRequest
addProperty Filter -> ReadRequest -> ReadRequest
addFilterToNode

addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
addOrderToNode [OrderTerm]
o (Node (ReadQuery
q,(Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
f) = (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery
q{$sel:order:Select :: [OrderTerm]
order=[OrderTerm]
o}, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
f

addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
addOrder = ([OrderTerm] -> ReadRequest -> ReadRequest)
-> (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
forall a.
(a -> ReadRequest -> ReadRequest)
-> (EmbedPath, a) -> ReadRequest -> ReadRequest
addProperty [OrderTerm] -> ReadRequest -> ReadRequest
addOrderToNode

addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
addRangeToNode NonnegRange
r (Node (ReadQuery
q,(Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
f) = (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery
q{$sel:range_:Select :: NonnegRange
range_=NonnegRange
r}, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
f

addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
addRange = (NonnegRange -> ReadRequest -> ReadRequest)
-> (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
forall a.
(a -> ReadRequest -> ReadRequest)
-> (EmbedPath, a) -> ReadRequest -> ReadRequest
addProperty NonnegRange -> ReadRequest -> ReadRequest
addRangeToNode

addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest
addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest
addLogicTreeToNode LogicTree
t (Node (q :: ReadQuery
q@Select{$sel:where_:Select :: ReadQuery -> [LogicTree]
where_=[LogicTree]
lf},(Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
f) = (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery
q{$sel:where_:Select :: [LogicTree]
where_=LogicTree
tLogicTree -> [LogicTree] -> [LogicTree]
forall a. a -> [a] -> [a]
:[LogicTree]
lf}::ReadQuery, (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer)
i) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
f

addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
addLogicTree = (LogicTree -> ReadRequest -> ReadRequest)
-> (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
forall a.
(a -> ReadRequest -> ReadRequest)
-> (EmbedPath, a) -> ReadRequest -> ReadRequest
addProperty LogicTree -> ReadRequest -> ReadRequest
addLogicTreeToNode

addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest
addProperty :: (a -> ReadRequest -> ReadRequest)
-> (EmbedPath, a) -> ReadRequest -> ReadRequest
addProperty a -> ReadRequest -> ReadRequest
f ([], a
a) ReadRequest
rr = a -> ReadRequest -> ReadRequest
f a
a ReadRequest
rr
addProperty a -> ReadRequest -> ReadRequest
f (Schema
targetNodeName:EmbedPath
remainingPath, a
a) (Node (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
rn Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest) =
  case Maybe ReadRequest
pathNode of
    Maybe ReadRequest
Nothing -> (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
rn Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest -- the property is silenty dropped in the Request does not contain the required path
    Just ReadRequest
tn -> (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> ReadRequest
forall a. a -> Forest a -> Tree a
Node (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
rn ((a -> ReadRequest -> ReadRequest)
-> (EmbedPath, a) -> ReadRequest -> ReadRequest
forall a.
(a -> ReadRequest -> ReadRequest)
-> (EmbedPath, a) -> ReadRequest -> ReadRequest
addProperty a -> ReadRequest -> ReadRequest
f (EmbedPath
remainingPath, a
a) ReadRequest
tnReadRequest
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forall a. a -> [a] -> [a]
:ReadRequest
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forall a. Eq a => a -> [a] -> [a]
delete ReadRequest
tn Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest)
  where
    pathNode :: Maybe ReadRequest
pathNode = (ReadRequest -> Bool)
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> Maybe ReadRequest
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Node (ReadQuery
_,(Schema
nodeName,Maybe Relationship
_,Maybe Schema
alias,Maybe Schema
_,Integer
_)) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
_) -> Schema
nodeName Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
targetNodeName Bool -> Bool -> Bool
|| Maybe Schema
alias Maybe Schema -> Maybe Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
targetNodeName) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest

mutateRequest :: Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest
mutateRequest :: Schema
-> Schema
-> ApiRequest
-> EmbedPath
-> ReadRequest
-> Either Error MutateRequest
mutateRequest Schema
schema Schema
tName ApiRequest
apiRequest EmbedPath
pkCols ReadRequest
readReq = (ApiRequestError -> Error)
-> Either ApiRequestError MutateRequest
-> Either Error MutateRequest
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ApiRequestError -> Error
ApiRequestError (Either ApiRequestError MutateRequest
 -> Either Error MutateRequest)
-> Either ApiRequestError MutateRequest
-> Either Error MutateRequest
forall a b. (a -> b) -> a -> b
$
  case Action
action of
    Action
ActionCreate -> do
        EmbedPath
confCols <- case ApiRequest -> Maybe Schema
iOnConflict ApiRequest
apiRequest of
            Maybe Schema
Nothing    -> EmbedPath -> Either ApiRequestError EmbedPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmbedPath
pkCols
            Just Schema
param -> Schema -> Either ApiRequestError EmbedPath
pRequestOnConflict Schema
param
        MutateRequest -> Either ApiRequestError MutateRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutateRequest -> Either ApiRequestError MutateRequest)
-> MutateRequest -> Either ApiRequestError MutateRequest
forall a b. (a -> b) -> a -> b
$ QualifiedIdentifier
-> Set Schema
-> Maybe ByteString
-> Maybe (PreferResolution, EmbedPath)
-> [LogicTree]
-> EmbedPath
-> MutateRequest
Insert QualifiedIdentifier
qi (ApiRequest -> Set Schema
iColumns ApiRequest
apiRequest) Maybe ByteString
body ((,) (PreferResolution -> EmbedPath -> (PreferResolution, EmbedPath))
-> Maybe PreferResolution
-> Maybe (EmbedPath -> (PreferResolution, EmbedPath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiRequest -> Maybe PreferResolution
iPreferResolution ApiRequest
apiRequest Maybe (EmbedPath -> (PreferResolution, EmbedPath))
-> Maybe EmbedPath -> Maybe (PreferResolution, EmbedPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EmbedPath -> Maybe EmbedPath
forall a. a -> Maybe a
Just EmbedPath
confCols) [] EmbedPath
returnings
    Action
ActionUpdate -> QualifiedIdentifier
-> Set Schema
-> Maybe ByteString
-> [LogicTree]
-> EmbedPath
-> MutateRequest
Update QualifiedIdentifier
qi (ApiRequest -> Set Schema
iColumns ApiRequest
apiRequest) Maybe ByteString
body  ([LogicTree] -> EmbedPath -> MutateRequest)
-> Either ApiRequestError [LogicTree]
-> Either ApiRequestError (EmbedPath -> MutateRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError [LogicTree]
combinedLogic Either ApiRequestError (EmbedPath -> MutateRequest)
-> Either ApiRequestError EmbedPath
-> Either ApiRequestError MutateRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EmbedPath -> Either ApiRequestError EmbedPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmbedPath
returnings
    Action
ActionSingleUpsert ->
      (\[Filter]
flts ->
        if [(Schema, Schema)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ApiRequest -> [(Schema, Schema)]
iLogic ApiRequest
apiRequest) Bool -> Bool -> Bool
&&
           EmbedPath -> Set Schema
forall a. Ord a => [a] -> Set a
S.fromList ((Schema, Schema) -> Schema
forall a b. (a, b) -> a
fst ((Schema, Schema) -> Schema) -> [(Schema, Schema)] -> EmbedPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiRequest -> [(Schema, Schema)]
iFilters ApiRequest
apiRequest) Set Schema -> Set Schema -> Bool
forall a. Eq a => a -> a -> Bool
== EmbedPath -> Set Schema
forall a. Ord a => [a] -> Set a
S.fromList EmbedPath
pkCols Bool -> Bool -> Bool
&&
           Bool -> Bool
not (Set Schema -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EmbedPath -> Set Schema
forall a. Ord a => [a] -> Set a
S.fromList EmbedPath
pkCols)) Bool -> Bool -> Bool
&&
           (Filter -> Bool) -> [Filter] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case
              Filter (Schema, JsonPath)
_ (OpExpr Bool
False (Op Schema
"eq" Schema
_)) -> Bool
True
              Filter
_                                   -> Bool
False) [Filter]
flts
          then QualifiedIdentifier
-> Set Schema
-> Maybe ByteString
-> Maybe (PreferResolution, EmbedPath)
-> [LogicTree]
-> EmbedPath
-> MutateRequest
Insert QualifiedIdentifier
qi (ApiRequest -> Set Schema
iColumns ApiRequest
apiRequest) Maybe ByteString
body ((PreferResolution, EmbedPath)
-> Maybe (PreferResolution, EmbedPath)
forall a. a -> Maybe a
Just (PreferResolution
MergeDuplicates, EmbedPath
pkCols)) ([LogicTree] -> EmbedPath -> MutateRequest)
-> Either ApiRequestError [LogicTree]
-> Either ApiRequestError (EmbedPath -> MutateRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError [LogicTree]
combinedLogic Either ApiRequestError (EmbedPath -> MutateRequest)
-> Either ApiRequestError EmbedPath
-> Either ApiRequestError MutateRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EmbedPath -> Either ApiRequestError EmbedPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmbedPath
returnings
        else
          ApiRequestError -> Either ApiRequestError MutateRequest
forall a b. a -> Either a b
Left ApiRequestError
InvalidFilters) ([Filter] -> Either ApiRequestError MutateRequest)
-> Either ApiRequestError [Filter]
-> Either ApiRequestError MutateRequest
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either ApiRequestError [Filter]
filters
    Action
ActionDelete -> QualifiedIdentifier -> [LogicTree] -> EmbedPath -> MutateRequest
Delete QualifiedIdentifier
qi ([LogicTree] -> EmbedPath -> MutateRequest)
-> Either ApiRequestError [LogicTree]
-> Either ApiRequestError (EmbedPath -> MutateRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError [LogicTree]
combinedLogic Either ApiRequestError (EmbedPath -> MutateRequest)
-> Either ApiRequestError EmbedPath
-> Either ApiRequestError MutateRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EmbedPath -> Either ApiRequestError EmbedPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmbedPath
returnings
    Action
_            -> ApiRequestError -> Either ApiRequestError MutateRequest
forall a b. a -> Either a b
Left ApiRequestError
UnsupportedVerb
  where
    qi :: QualifiedIdentifier
qi = Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier Schema
schema Schema
tName
    action :: Action
action = ApiRequest -> Action
iAction ApiRequest
apiRequest
    returnings :: EmbedPath
returnings =
      if ApiRequest -> PreferRepresentation
iPreferRepresentation ApiRequest
apiRequest PreferRepresentation -> PreferRepresentation -> Bool
forall a. Eq a => a -> a -> Bool
== PreferRepresentation
None
        then []
        else ReadRequest -> EmbedPath -> EmbedPath
returningCols ReadRequest
readReq EmbedPath
pkCols
    filters :: Either ApiRequestError [Filter]
filters = ((EmbedPath, Filter) -> Filter)
-> [(EmbedPath, Filter)] -> [Filter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (EmbedPath, Filter) -> Filter
forall a b. (a, b) -> b
snd ([(EmbedPath, Filter)] -> [Filter])
-> Either ApiRequestError [(EmbedPath, Filter)]
-> Either ApiRequestError [Filter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema, Schema) -> Either ApiRequestError (EmbedPath, Filter)
pRequestFilter ((Schema, Schema) -> Either ApiRequestError (EmbedPath, Filter))
-> [(Schema, Schema)]
-> Either ApiRequestError [(EmbedPath, Filter)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [(Schema, Schema)]
mutateFilters
    logic :: Either ApiRequestError [LogicTree]
logic = ((EmbedPath, LogicTree) -> LogicTree)
-> [(EmbedPath, LogicTree)] -> [LogicTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (EmbedPath, LogicTree) -> LogicTree
forall a b. (a, b) -> b
snd ([(EmbedPath, LogicTree)] -> [LogicTree])
-> Either ApiRequestError [(EmbedPath, LogicTree)]
-> Either ApiRequestError [LogicTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema, Schema) -> Either ApiRequestError (EmbedPath, LogicTree)
pRequestLogicTree ((Schema, Schema) -> Either ApiRequestError (EmbedPath, LogicTree))
-> [(Schema, Schema)]
-> Either ApiRequestError [(EmbedPath, LogicTree)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [(Schema, Schema)]
logicFilters
    combinedLogic :: Either ApiRequestError [LogicTree]
combinedLogic = (Filter -> [LogicTree] -> [LogicTree])
-> [LogicTree] -> [Filter] -> [LogicTree]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Filter -> [LogicTree] -> [LogicTree]
addFilterToLogicForest ([LogicTree] -> [Filter] -> [LogicTree])
-> Either ApiRequestError [LogicTree]
-> Either ApiRequestError ([Filter] -> [LogicTree])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ApiRequestError [LogicTree]
logic Either ApiRequestError ([Filter] -> [LogicTree])
-> Either ApiRequestError [Filter]
-> Either ApiRequestError [LogicTree]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either ApiRequestError [Filter]
filters
    -- update/delete filters can be only on the root table
    ([(Schema, Schema)]
mutateFilters, [(Schema, Schema)]
logicFilters) = (([(Schema, Schema)] -> [(Schema, Schema)])
 -> ([(Schema, Schema)] -> [(Schema, Schema)])
 -> ([(Schema, Schema)], [(Schema, Schema)])
 -> ([(Schema, Schema)], [(Schema, Schema)]))
-> ([(Schema, Schema)] -> [(Schema, Schema)])
-> ([(Schema, Schema)], [(Schema, Schema)])
-> ([(Schema, Schema)], [(Schema, Schema)])
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([(Schema, Schema)] -> [(Schema, Schema)])
-> ([(Schema, Schema)] -> [(Schema, Schema)])
-> ([(Schema, Schema)], [(Schema, Schema)])
-> ([(Schema, Schema)], [(Schema, Schema)])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) [(Schema, Schema)] -> [(Schema, Schema)]
forall b. [(Schema, b)] -> [(Schema, b)]
onlyRoot (ApiRequest -> [(Schema, Schema)]
iFilters ApiRequest
apiRequest, ApiRequest -> [(Schema, Schema)]
iLogic ApiRequest
apiRequest)
    onlyRoot :: [(Schema, b)] -> [(Schema, b)]
onlyRoot = ((Schema, b) -> Bool) -> [(Schema, b)] -> [(Schema, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Schema, b) -> Bool) -> (Schema, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( Schema
"." Schema -> Schema -> Bool
`isInfixOf` ) (Schema -> Bool) -> ((Schema, b) -> Schema) -> (Schema, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema, b) -> Schema
forall a b. (a, b) -> a
fst)
    body :: Maybe ByteString
body = PayloadJSON -> ByteString
pjRaw (PayloadJSON -> ByteString)
-> Maybe PayloadJSON -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiRequest -> Maybe PayloadJSON
iPayload ApiRequest
apiRequest

returningCols :: ReadRequest -> [FieldName] -> [FieldName]
returningCols :: ReadRequest -> EmbedPath -> EmbedPath
returningCols rr :: ReadRequest
rr@(Node (ReadQuery,
 (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
_ Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest) EmbedPath
pkCols
  -- if * is part of the select, we must not add pk or fk columns manually -
  -- otherwise those would be selected and output twice
  | Schema
"*" Schema -> EmbedPath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` EmbedPath
fldNames = [Schema
"*"]
  | Bool
otherwise           = EmbedPath
returnings
  where
    fldNames :: EmbedPath
fldNames = ReadRequest -> EmbedPath
fstFieldNames ReadRequest
rr
    -- Without fkCols, when a mutateRequest to
    -- /projects?select=name,clients(name) occurs, the RETURNING SQL part would
    -- be `RETURNING name`(see QueryBuilder).  This would make the embedding
    -- fail because the following JOIN would need the "client_id" column from
    -- projects.  So this adds the foreign key columns to ensure the embedding
    -- succeeds, result would be `RETURNING name, client_id`.
    fkCols :: [Column]
fkCols = [[Column]] -> [Column]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Column]] -> [Column]) -> [[Column]] -> [Column]
forall a b. (a -> b) -> a -> b
$ (ReadRequest -> Maybe [Column])
-> Forest
     (ReadQuery,
      (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
-> [[Column]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
        Node (ReadQuery
_, (Schema
_, Just Relationship{relColumns :: Relationship -> [Column]
relColumns=[Column]
cols}, Maybe Schema
_, Maybe Schema
_, Integer
_)) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
_ -> [Column] -> Maybe [Column]
forall a. a -> Maybe a
Just [Column]
cols
        ReadRequest
_                                                        -> Maybe [Column]
forall a. Maybe a
Nothing
      ) Forest
  (ReadQuery,
   (Schema, Maybe Relationship, Maybe Schema, Maybe Schema, Integer))
forest
    -- However if the "client_id" is present, e.g. mutateRequest to
    -- /projects?select=client_id,name,clients(name) we would get `RETURNING
    -- client_id, name, client_id` and then we would produce the "column
    -- reference \"client_id\" is ambiguous" error from PostgreSQL. So we
    -- deduplicate with Set: We are adding the primary key columns as well to
    -- make sure, that a proper location header can always be built for
    -- INSERT/POST
    returnings :: EmbedPath
returnings = Set Schema -> EmbedPath
forall a. Set a -> [a]
S.toList (Set Schema -> EmbedPath)
-> (EmbedPath -> Set Schema) -> EmbedPath -> EmbedPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmbedPath -> Set Schema
forall a. Ord a => [a] -> Set a
S.fromList (EmbedPath -> EmbedPath) -> EmbedPath -> EmbedPath
forall a b. (a -> b) -> a -> b
$ EmbedPath
fldNames EmbedPath -> EmbedPath -> EmbedPath
forall a. [a] -> [a] -> [a]
++ (Column -> Schema
colName (Column -> Schema) -> [Column] -> EmbedPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column]
fkCols) EmbedPath -> EmbedPath -> EmbedPath
forall a. [a] -> [a] -> [a]
++ EmbedPath
pkCols

-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
-- they are later concatenated with AND in the QueryBuilder
addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree]
addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree]
addFilterToLogicForest Filter
flt [LogicTree]
lf = Filter -> LogicTree
Stmnt Filter
flt LogicTree -> [LogicTree] -> [LogicTree]
forall a. a -> [a] -> [a]
: [LogicTree]
lf