{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.Plan.Operation
  ( Operation (..)
  , AssertionFailed
  , mkAssertionFailed
  , WherePlanner (..)
  , byField
  , byFieldTuple
  , findOne
  , findOneWhere
  , findAll
  , findAllWhere
  , findSelect
  , askParam
  , assertRight
  , SelectOperation (..)
  , selectOperation
  )
where

import Control.Exception (Exception)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Foldable as Fold
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Text as T

import qualified Orville.PostgreSQL.Execution as Exec
import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Marshall as Marshall
import qualified Orville.PostgreSQL.Monad as Monad
import qualified Orville.PostgreSQL.Plan.Explanation as Exp
import Orville.PostgreSQL.Plan.Many (Many)
import qualified Orville.PostgreSQL.Plan.Many as Many
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
import qualified Orville.PostgreSQL.Schema as Schema

{- |
  'Operation' provides a stucture for building primitive operations that can be
  incorporated into a 'Database.Orville.PostgreSQL.Plan.Plan'. An 'Operation'
  provides base case implementations of the various plan execution functions.
  You only need to care about this type if you want to create new custom
  operations to include in a 'Database.Orville.PostgreSQL.Plan.Plan' beyond
  those already provided in the 'Database.Orville.PostgreSQL.Plan.Plan'
  API.

  You can build your own custom 'Operation' values either directly, or using
  the function and types in this module, such as 'WherePlanner' (via 'findAll',
  etc), or 'SelectOperation' (via 'selectOperation').

@since 1.0.0.0
-}
data Operation param result = Operation
  { forall param result.
Operation param result
-> forall (m :: * -> *).
   MonadOrville m =>
   param -> m (Either AssertionFailed result)
executeOperationOne ::
      forall m.
      Monad.MonadOrville m =>
      param ->
      m (Either AssertionFailed result)
  -- ^ 'executeOperationOne' will be called when a plan is
  -- executed with a single input parameter.
  , forall param result.
Operation param result
-> forall (m :: * -> *).
   MonadOrville m =>
   NonEmpty param -> m (Either AssertionFailed (Many param result))
executeOperationMany ::
      forall m.
      Monad.MonadOrville m =>
      NonEmpty param ->
      m (Either AssertionFailed (Many param result))
  -- ^ 'executeOperationMany' will be called when a plan is executed with
  -- multiple input parameters (via 'Orville.PostgreSQL.Plan.planMany').
  , forall param result. Operation param result -> Explanation
explainOperationOne :: Exp.Explanation
  -- ^ 'explainOperationOne' will be called when producing an explanation
  -- of what the plan will do when given one input parameter. Plans that do
  -- not perform any interesting IO interactions should generally return an
  -- empty explanation.
  , forall param result. Operation param result -> Explanation
explainOperationMany :: Exp.Explanation
  -- ^ 'explainOperationMany' will be called when producing an explanation of
  -- what the plan will do when given multiple input parameters (via
  -- 'Orville.PostgreSQL.Plan.planMany'). Plans that do not perform any
  -- interesting IO interactions should generally return an empty explanation.
  }

{- |
  'AssertionFailed' may be returned from the execute functions of an
  'Operation' to indicate that some expected invariant has failed. For example,
  following a foreign key that is enforced by the database only to find that no
  record exists. When an 'Operation' returns an 'AssertionFailed' value during
  plan execution, the error is thrown as an exception using the
  'Control.Monad.Catch.MonadThrow' instance for whatever monad the plan is
  executing in.

@since 1.0.0.0
-}
newtype AssertionFailed
  = AssertionFailed String
  deriving (Int -> AssertionFailed -> ShowS
[AssertionFailed] -> ShowS
AssertionFailed -> String
(Int -> AssertionFailed -> ShowS)
-> (AssertionFailed -> String)
-> ([AssertionFailed] -> ShowS)
-> Show AssertionFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssertionFailed -> ShowS
showsPrec :: Int -> AssertionFailed -> ShowS
$cshow :: AssertionFailed -> String
show :: AssertionFailed -> String
$cshowList :: [AssertionFailed] -> ShowS
showList :: [AssertionFailed] -> ShowS
Show)

{- |
  'mkAssertionFailed' builds an 'AssertionFailed' error from an error message.

@since 1.0.0.0
-}
mkAssertionFailed :: String -> AssertionFailed
mkAssertionFailed :: String -> AssertionFailed
mkAssertionFailed =
  String -> AssertionFailed
AssertionFailed

instance Exception AssertionFailed

{- |
  'askParam' simply returns the parameter given from the plan.

@since 1.0.0.0
-}
askParam :: Operation param param
askParam :: forall param. Operation param param
askParam =
  Operation
    { executeOperationOne :: forall (m :: * -> *).
MonadOrville m =>
param -> m (Either AssertionFailed param)
executeOperationOne = Either AssertionFailed param -> m (Either AssertionFailed param)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AssertionFailed param -> m (Either AssertionFailed param))
-> (param -> Either AssertionFailed param)
-> param
-> m (Either AssertionFailed param)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. param -> Either AssertionFailed param
forall a b. b -> Either a b
Right
    , executeOperationMany :: forall (m :: * -> *).
MonadOrville m =>
NonEmpty param -> m (Either AssertionFailed (Many param param))
executeOperationMany = \NonEmpty param
params -> Either AssertionFailed (Many param param)
-> m (Either AssertionFailed (Many param param))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AssertionFailed (Many param param)
 -> m (Either AssertionFailed (Many param param)))
-> (Many param param -> Either AssertionFailed (Many param param))
-> Many param param
-> m (Either AssertionFailed (Many param param))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many param param -> Either AssertionFailed (Many param param)
forall a b. b -> Either a b
Right (Many param param -> m (Either AssertionFailed (Many param param)))
-> Many param param
-> m (Either AssertionFailed (Many param param))
forall a b. (a -> b) -> a -> b
$ [param] -> (param -> Either NotAKey param) -> Many param param
forall k a. [k] -> (k -> Either NotAKey a) -> Many k a
Many.fromKeys (NonEmpty param -> [param]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList NonEmpty param
params) param -> Either NotAKey param
forall a b. b -> Either a b
Right
    , explainOperationOne :: Explanation
explainOperationOne = Explanation
Exp.noExplanation
    , explainOperationMany :: Explanation
explainOperationMany = Explanation
Exp.noExplanation
    }

{- |
  'assertRight' returns the value on the 'Right' side of an 'Either'. If
  the 'Either' is a 'Left', it raises 'AssertionFailed' with the message
  from the 'Left' side of the 'Either'.

@since 1.0.0.0
-}
assertRight :: Operation (Either String a) a
assertRight :: forall a. Operation (Either String a) a
assertRight =
  Operation
    { executeOperationOne :: forall (m :: * -> *).
MonadOrville m =>
Either String a -> m (Either AssertionFailed a)
executeOperationOne = \Either String a
eitherA ->
        Either AssertionFailed a -> m (Either AssertionFailed a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AssertionFailed a -> m (Either AssertionFailed a))
-> Either AssertionFailed a -> m (Either AssertionFailed a)
forall a b. (a -> b) -> a -> b
$
          case Either String a
eitherA of
            Left String
err ->
              AssertionFailed -> Either AssertionFailed a
forall a b. a -> Either a b
Left (String -> AssertionFailed
AssertionFailed (String -> AssertionFailed) -> String -> AssertionFailed
forall a b. (a -> b) -> a -> b
$ String
"Assertion failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err)
            Right a
b ->
              a -> Either AssertionFailed a
forall a b. b -> Either a b
Right a
b
    , executeOperationMany :: forall (m :: * -> *).
MonadOrville m =>
NonEmpty (Either String a)
-> m (Either AssertionFailed (Many (Either String a) a))
executeOperationMany = \NonEmpty (Either String a)
eitherAs ->
        Either AssertionFailed (Many (Either String a) a)
-> m (Either AssertionFailed (Many (Either String a) a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AssertionFailed (Many (Either String a) a)
 -> m (Either AssertionFailed (Many (Either String a) a)))
-> Either AssertionFailed (Many (Either String a) a)
-> m (Either AssertionFailed (Many (Either String a) a))
forall a b. (a -> b) -> a -> b
$
          case NonEmpty (Either String a) -> Either String (NonEmpty a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => NonEmpty (m a) -> m (NonEmpty a)
sequence NonEmpty (Either String a)
eitherAs of
            Left String
err ->
              AssertionFailed
-> Either AssertionFailed (Many (Either String a) a)
forall a b. a -> Either a b
Left (String -> AssertionFailed
AssertionFailed (String -> AssertionFailed) -> String -> AssertionFailed
forall a b. (a -> b) -> a -> b
$ String
"Assertion failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err)
            Right NonEmpty a
_ ->
              let
                errorOnLeft :: forall a b. Either a b -> Either Many.NotAKey b
                errorOnLeft :: forall a b. Either a b -> Either NotAKey b
errorOnLeft Either a b
eitherA =
                  case Either a b
eitherA of
                    Left a
_ ->
                      -- We proved all the values above didn't have any lefts in
                      -- then, so if we get a left here it must not be one of the
                      -- keys from the Many.
                      NotAKey -> Either NotAKey b
forall a b. a -> Either a b
Left NotAKey
Many.NotAKey
                    Right b
a ->
                      b -> Either NotAKey b
forall a b. b -> Either a b
Right b
a
              in
                Many (Either String a) a
-> Either AssertionFailed (Many (Either String a) a)
forall a b. b -> Either a b
Right (Many (Either String a) a
 -> Either AssertionFailed (Many (Either String a) a))
-> Many (Either String a) a
-> Either AssertionFailed (Many (Either String a) a)
forall a b. (a -> b) -> a -> b
$ [Either String a]
-> (Either String a -> Either NotAKey a)
-> Many (Either String a) a
forall k a. [k] -> (k -> Either NotAKey a) -> Many k a
Many.fromKeys (NonEmpty (Either String a) -> [Either String a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList NonEmpty (Either String a)
eitherAs) Either String a -> Either NotAKey a
forall a b. Either a b -> Either NotAKey b
errorOnLeft
    , explainOperationOne :: Explanation
explainOperationOne = Explanation
Exp.noExplanation
    , explainOperationMany :: Explanation
explainOperationMany = Explanation
Exp.noExplanation
    }

{- |
  The functions below ('findOne', 'findAll', etc) accept a 'WherePlanner'
  to determine how to build the where conditions for executing a 'Exec.Select'
  statement as part of a plan operation.

  For simple queries, you can use the functions such as 'byField' that are
  provided here to build a 'WherePlanner', but you may also build your own
  custom 'WherePlanner' for more advanced use cases.

  If you need to execute a custom query that cannot be built by providing a
  custom where clause via 'WherePlanner', you may want to use more
  direct 'selectOperation' functions.

@since 1.0.0.0
-}
data WherePlanner param = WherePlanner
  { forall param.
WherePlanner param
-> forall entity. (entity -> param) -> SqlMarshaller entity param
paramMarshaller :: forall entity. (entity -> param) -> Marshall.SqlMarshaller entity param
  -- ^ The 'paramMarshaller' function provided here will be used to decode
  -- the parameter field from the result set so that the row can be properly
  -- associated with the input parameter that matched it.
  , forall param. WherePlanner param -> param -> BooleanExpr
executeOneWhereCondition :: param -> Expr.BooleanExpr
  -- ^ 'executeOneWhereCondition' must build a where condition that will
  -- match only those rows that match the input paramater.
  , forall param. WherePlanner param -> NonEmpty param -> BooleanExpr
executeManyWhereCondition :: NonEmpty param -> Expr.BooleanExpr
  -- ^ 'executeManyWhereCondition' must build a where condition that will
  -- match only those rows that match any (not all!) of the input parameters.
  , forall param. WherePlanner param -> BooleanExpr
explainOneWhereCondition :: Expr.BooleanExpr
  -- ^ 'explainOneWhereCondition' must build a where condition that is suitable
  -- to be used as an example of what 'executeManyWhereCondition' would return
  -- when given a parameter. This where condition will be used when producing
  -- explanations of plans. For example, this could fill in either an example
  -- or dummy value.
  , forall param. WherePlanner param -> BooleanExpr
explainManyWhereCondition :: Expr.BooleanExpr
  -- ^ 'explainManyWhereCondition' must build a where condition that is
  -- suitable to be used as an example of what 'executeOneWhereCondition' would
  -- return when given a list of parameters. This where condition will be
  -- used when producing explanations of plans. For example, this could fill in
  -- either an example or dummy value.
  }

{- |
  Builds a 'WherePlanner' that will match on a single
  'FieldDefinition.FieldDefinition'.  The resulting 'WherePlanner' can be used
  with functions such as 'findOne' and 'findAll' to construct an 'Operation'.

@since 1.0.0.0
-}
byField ::
  Ord fieldValue =>
  Marshall.FieldDefinition nullability fieldValue ->
  WherePlanner fieldValue
byField :: forall fieldValue nullability.
Ord fieldValue =>
FieldDefinition nullability fieldValue -> WherePlanner fieldValue
byField FieldDefinition nullability fieldValue
fieldDef =
  let
    stringyField :: FieldDefinition nullability Text
stringyField =
      FieldDefinition nullability fieldValue
-> FieldDefinition nullability Text
forall nullability a.
FieldDefinition nullability a -> FieldDefinition nullability Text
stringifyField FieldDefinition nullability fieldValue
fieldDef
  in
    WherePlanner
      { paramMarshaller :: forall entity.
(entity -> fieldValue) -> SqlMarshaller entity fieldValue
paramMarshaller = ((entity -> fieldValue)
 -> FieldDefinition nullability fieldValue
 -> SqlMarshaller entity fieldValue)
-> FieldDefinition nullability fieldValue
-> (entity -> fieldValue)
-> SqlMarshaller entity fieldValue
forall a b c. (a -> b -> c) -> b -> a -> c
flip (entity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller entity fieldValue
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Marshall.marshallField FieldDefinition nullability fieldValue
fieldDef
      , executeOneWhereCondition :: fieldValue -> BooleanExpr
executeOneWhereCondition = \fieldValue
fieldValue -> FieldDefinition nullability fieldValue -> fieldValue -> BooleanExpr
forall nullability a.
FieldDefinition nullability a -> a -> BooleanExpr
Marshall.fieldEquals FieldDefinition nullability fieldValue
fieldDef fieldValue
fieldValue
      , executeManyWhereCondition :: NonEmpty fieldValue -> BooleanExpr
executeManyWhereCondition = \NonEmpty fieldValue
fieldValues -> FieldDefinition nullability fieldValue
-> NonEmpty fieldValue -> BooleanExpr
forall nullability a.
FieldDefinition nullability a -> NonEmpty a -> BooleanExpr
Marshall.fieldIn FieldDefinition nullability fieldValue
fieldDef (NonEmpty fieldValue -> NonEmpty fieldValue
forall a. Ord a => NonEmpty a -> NonEmpty a
dedupeFieldValues NonEmpty fieldValue
fieldValues)
      , explainOneWhereCondition :: BooleanExpr
explainOneWhereCondition = FieldDefinition nullability Text -> Text -> BooleanExpr
forall nullability a.
FieldDefinition nullability a -> a -> BooleanExpr
Marshall.fieldEquals FieldDefinition nullability Text
stringyField (Text -> BooleanExpr) -> Text -> BooleanExpr
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"EXAMPLE VALUE"
      , explainManyWhereCondition :: BooleanExpr
explainManyWhereCondition = FieldDefinition nullability Text -> NonEmpty Text -> BooleanExpr
forall nullability a.
FieldDefinition nullability a -> NonEmpty a -> BooleanExpr
Marshall.fieldIn FieldDefinition nullability Text
stringyField (NonEmpty Text -> BooleanExpr) -> NonEmpty Text -> BooleanExpr
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> NonEmpty String -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (String
"EXAMPLE VALUE 1" String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String
"EXAMPLE VALUE 2"])
      }

{- |
  Builds a 'WherePlanner' that will match on a 2-tuple of
  'FieldDefinition.FieldDefinition's.  The resulting 'WherePlanner' can be used
  with functions such as 'findOne' and 'findAll' to construct an 'Operation'.

@since 1.0.0.0
-}
byFieldTuple ::
  forall nullabilityA fieldValueA nullabilityB fieldValueB.
  (Ord fieldValueA, Ord fieldValueB) =>
  Marshall.FieldDefinition nullabilityA fieldValueA ->
  Marshall.FieldDefinition nullabilityB fieldValueB ->
  WherePlanner (fieldValueA, fieldValueB)
byFieldTuple :: forall nullabilityA fieldValueA nullabilityB fieldValueB.
(Ord fieldValueA, Ord fieldValueB) =>
FieldDefinition nullabilityA fieldValueA
-> FieldDefinition nullabilityB fieldValueB
-> WherePlanner (fieldValueA, fieldValueB)
byFieldTuple FieldDefinition nullabilityA fieldValueA
fieldDefA FieldDefinition nullabilityB fieldValueB
fieldDefB =
  let
    stringyFieldA :: FieldDefinition nullabilityA Text
stringyFieldA =
      FieldDefinition nullabilityA fieldValueA
-> FieldDefinition nullabilityA Text
forall nullability a.
FieldDefinition nullability a -> FieldDefinition nullability Text
stringifyField FieldDefinition nullabilityA fieldValueA
fieldDefA

    stringyFieldB :: FieldDefinition nullabilityB Text
stringyFieldB =
      FieldDefinition nullabilityB fieldValueB
-> FieldDefinition nullabilityB Text
forall nullability a.
FieldDefinition nullability a -> FieldDefinition nullability Text
stringifyField FieldDefinition nullabilityB fieldValueB
fieldDefB

    marshaller ::
      (a -> (fieldValueA, fieldValueB)) ->
      Marshall.SqlMarshaller a (fieldValueA, fieldValueB)
    marshaller :: forall entity.
(entity -> (fieldValueA, fieldValueB))
-> SqlMarshaller entity (fieldValueA, fieldValueB)
marshaller a -> (fieldValueA, fieldValueB)
accessor =
      (,)
        (fieldValueA -> fieldValueB -> (fieldValueA, fieldValueB))
-> SqlMarshaller a fieldValueA
-> SqlMarshaller a (fieldValueB -> (fieldValueA, fieldValueB))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> fieldValueA)
-> FieldDefinition nullabilityA fieldValueA
-> SqlMarshaller a fieldValueA
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Marshall.marshallField ((fieldValueA, fieldValueB) -> fieldValueA
forall a b. (a, b) -> a
fst ((fieldValueA, fieldValueB) -> fieldValueA)
-> (a -> (fieldValueA, fieldValueB)) -> a -> fieldValueA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (fieldValueA, fieldValueB)
accessor) FieldDefinition nullabilityA fieldValueA
fieldDefA
        SqlMarshaller a (fieldValueB -> (fieldValueA, fieldValueB))
-> SqlMarshaller a fieldValueB
-> SqlMarshaller a (fieldValueA, fieldValueB)
forall a b.
SqlMarshaller a (a -> b) -> SqlMarshaller a a -> SqlMarshaller a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> fieldValueB)
-> FieldDefinition nullabilityB fieldValueB
-> SqlMarshaller a fieldValueB
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Marshall.marshallField ((fieldValueA, fieldValueB) -> fieldValueB
forall a b. (a, b) -> b
snd ((fieldValueA, fieldValueB) -> fieldValueB)
-> (a -> (fieldValueA, fieldValueB)) -> a -> fieldValueB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (fieldValueA, fieldValueB)
accessor) FieldDefinition nullabilityB fieldValueB
fieldDefB

    packAll :: NonEmpty (String, String) -> NonEmpty (Text, Text)
packAll =
      ((String, String) -> (Text, Text))
-> NonEmpty (String, String) -> NonEmpty (Text, Text)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
a, String
b) -> (String -> Text
T.pack String
a, String -> Text
T.pack String
b))
  in
    WherePlanner
      { paramMarshaller :: forall entity.
(entity -> (fieldValueA, fieldValueB))
-> SqlMarshaller entity (fieldValueA, fieldValueB)
paramMarshaller = (entity -> (fieldValueA, fieldValueB))
-> SqlMarshaller entity (fieldValueA, fieldValueB)
forall entity.
(entity -> (fieldValueA, fieldValueB))
-> SqlMarshaller entity (fieldValueA, fieldValueB)
marshaller
      , executeOneWhereCondition :: (fieldValueA, fieldValueB) -> BooleanExpr
executeOneWhereCondition = \(fieldValueA, fieldValueB)
fieldValue -> FieldDefinition nullabilityA fieldValueA
-> FieldDefinition nullabilityB fieldValueB
-> NonEmpty (fieldValueA, fieldValueB)
-> BooleanExpr
forall nullabilityA a nullabilityB b.
FieldDefinition nullabilityA a
-> FieldDefinition nullabilityB b -> NonEmpty (a, b) -> BooleanExpr
Marshall.fieldTupleIn FieldDefinition nullabilityA fieldValueA
fieldDefA FieldDefinition nullabilityB fieldValueB
fieldDefB ((fieldValueA, fieldValueB)
fieldValue (fieldValueA, fieldValueB)
-> [(fieldValueA, fieldValueB)]
-> NonEmpty (fieldValueA, fieldValueB)
forall a. a -> [a] -> NonEmpty a
:| [])
      , executeManyWhereCondition :: NonEmpty (fieldValueA, fieldValueB) -> BooleanExpr
executeManyWhereCondition = \NonEmpty (fieldValueA, fieldValueB)
fieldValues -> FieldDefinition nullabilityA fieldValueA
-> FieldDefinition nullabilityB fieldValueB
-> NonEmpty (fieldValueA, fieldValueB)
-> BooleanExpr
forall nullabilityA a nullabilityB b.
FieldDefinition nullabilityA a
-> FieldDefinition nullabilityB b -> NonEmpty (a, b) -> BooleanExpr
Marshall.fieldTupleIn FieldDefinition nullabilityA fieldValueA
fieldDefA FieldDefinition nullabilityB fieldValueB
fieldDefB (NonEmpty (fieldValueA, fieldValueB)
-> NonEmpty (fieldValueA, fieldValueB)
forall a. Ord a => NonEmpty a -> NonEmpty a
dedupeFieldValues NonEmpty (fieldValueA, fieldValueB)
fieldValues)
      , explainOneWhereCondition :: BooleanExpr
explainOneWhereCondition =
          FieldDefinition nullabilityA Text
-> FieldDefinition nullabilityB Text
-> NonEmpty (Text, Text)
-> BooleanExpr
forall nullabilityA a nullabilityB b.
FieldDefinition nullabilityA a
-> FieldDefinition nullabilityB b -> NonEmpty (a, b) -> BooleanExpr
Marshall.fieldTupleIn
            FieldDefinition nullabilityA Text
stringyFieldA
            FieldDefinition nullabilityB Text
stringyFieldB
            (NonEmpty (String, String) -> NonEmpty (Text, Text)
packAll (NonEmpty (String, String) -> NonEmpty (Text, Text))
-> NonEmpty (String, String) -> NonEmpty (Text, Text)
forall a b. (a -> b) -> a -> b
$ (String
"EXAMPLE VALUE A", String
"EXAMPLE VALUE B") (String, String) -> [(String, String)] -> NonEmpty (String, String)
forall a. a -> [a] -> NonEmpty a
:| [])
      , explainManyWhereCondition :: BooleanExpr
explainManyWhereCondition =
          FieldDefinition nullabilityA Text
-> FieldDefinition nullabilityB Text
-> NonEmpty (Text, Text)
-> BooleanExpr
forall nullabilityA a nullabilityB b.
FieldDefinition nullabilityA a
-> FieldDefinition nullabilityB b -> NonEmpty (a, b) -> BooleanExpr
Marshall.fieldTupleIn
            FieldDefinition nullabilityA Text
stringyFieldA
            FieldDefinition nullabilityB Text
stringyFieldB
            (NonEmpty (String, String) -> NonEmpty (Text, Text)
packAll (NonEmpty (String, String) -> NonEmpty (Text, Text))
-> NonEmpty (String, String) -> NonEmpty (Text, Text)
forall a b. (a -> b) -> a -> b
$ ((String
"EXAMPLE VALUE A 1", String
"EXAMPLE VALUE B 1") (String, String) -> [(String, String)] -> NonEmpty (String, String)
forall a. a -> [a] -> NonEmpty a
:| [(String
"EXAMPLE VALUE A 2", String
"EXAMPLE VALUE B 2")]))
      }

dedupeFieldValues :: Ord a => NonEmpty a -> NonEmpty a
dedupeFieldValues :: forall a. Ord a => NonEmpty a -> NonEmpty a
dedupeFieldValues (a
first :| [a]
rest) =
  let
    dedupedWithoutFirst :: [a]
dedupedWithoutFirst =
      Set a -> [a]
forall a. Set a -> [a]
Set.toList
        (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
first
        (Set a -> Set a) -> ([a] -> Set a) -> [a] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList
        ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
rest
  in
    a
first a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
dedupedWithoutFirst

{- |
  'findOne' builds a planning primitive that finds (at most) one row from the
  given table where the column value for the provided 'Core.FieldDefinition'
  matches the plan's input parameter. When executed on multiple parameters, it
  fetches all rows where the field matches the inputs and arbitrarily picks at
  most one of those rows to use as the result for each input.

@since 1.0.0.0
-}
findOne ::
  Ord param =>
  Schema.TableDefinition key writeEntity readEntity ->
  WherePlanner param ->
  Operation param (Maybe readEntity)
findOne :: forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param -> Operation param (Maybe readEntity)
findOne TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner =
  TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param (Maybe readEntity)
forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param (Maybe readEntity)
findOneWithOpts TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner SelectOptions
forall a. Monoid a => a
mempty

{- |
  'findOneWhere' is similar to 'findOne' but allows a 'Expr.BooleanExpr' to be
  specified that is added to the database query to restrict which rows are
  returned.

@since 1.0.0.0
-}
findOneWhere ::
  Ord param =>
  Schema.TableDefinition key writeEntity readEntity ->
  WherePlanner param ->
  Expr.BooleanExpr ->
  Operation param (Maybe readEntity)
findOneWhere :: forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param
-> BooleanExpr
-> Operation param (Maybe readEntity)
findOneWhere TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner BooleanExpr
cond =
  TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param (Maybe readEntity)
forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param (Maybe readEntity)
findOneWithOpts TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner (BooleanExpr -> SelectOptions
Exec.where_ BooleanExpr
cond)

{- |
  'findOneWithOpts' is a internal helper used by 'findOne' and 'findOneWhere'.

@since 1.0.0.0
-}
findOneWithOpts ::
  Ord param =>
  Schema.TableDefinition key writeEntity readEntity ->
  WherePlanner param ->
  Exec.SelectOptions ->
  Operation param (Maybe readEntity)
findOneWithOpts :: forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param (Maybe readEntity)
findOneWithOpts TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner SelectOptions
opts =
  SelectOperation param (param, readEntity) (Maybe readEntity)
-> Operation param (Maybe readEntity)
forall param row result.
Ord param =>
SelectOperation param row result -> Operation param result
selectOperation SelectOperation param (param, readEntity) (Maybe readEntity)
selectOp
 where
  selectOp :: SelectOperation param (param, readEntity) (Maybe readEntity)
selectOp =
    SelectOperation
      { selectOne :: param -> Select (param, readEntity)
selectOne = \param
param ->
          SelectOptions -> Select (param, readEntity)
select (SelectOptions
opts SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> BooleanExpr -> SelectOptions
Exec.where_ (WherePlanner param -> param -> BooleanExpr
forall param. WherePlanner param -> param -> BooleanExpr
executeOneWhereCondition WherePlanner param
wherePlanner param
param) SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> Int -> SelectOptions
Exec.limit Int
1)
      , selectMany :: NonEmpty param -> Select (param, readEntity)
selectMany = \NonEmpty param
params ->
          SelectOptions -> Select (param, readEntity)
select (SelectOptions
opts SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> BooleanExpr -> SelectOptions
Exec.where_ (WherePlanner param -> NonEmpty param -> BooleanExpr
forall param. WherePlanner param -> NonEmpty param -> BooleanExpr
executeManyWhereCondition WherePlanner param
wherePlanner NonEmpty param
params))
      , explainSelectOne :: Select (param, readEntity)
explainSelectOne =
          SelectOptions -> Select (param, readEntity)
select (SelectOptions
opts SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> BooleanExpr -> SelectOptions
Exec.where_ (WherePlanner param -> BooleanExpr
forall param. WherePlanner param -> BooleanExpr
explainOneWhereCondition WherePlanner param
wherePlanner))
      , explainSelectMany :: Select (param, readEntity)
explainSelectMany =
          SelectOptions -> Select (param, readEntity)
select (SelectOptions
opts SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> BooleanExpr -> SelectOptions
Exec.where_ (WherePlanner param -> BooleanExpr
forall param. WherePlanner param -> BooleanExpr
explainManyWhereCondition WherePlanner param
wherePlanner))
      , categorizeRow :: (param, readEntity) -> param
categorizeRow = (param, readEntity) -> param
forall a b. (a, b) -> a
fst
      , produceResult :: [(param, readEntity)] -> Maybe readEntity
produceResult = ((param, readEntity) -> readEntity)
-> Maybe (param, readEntity) -> Maybe readEntity
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (param, readEntity) -> readEntity
forall a b. (a, b) -> b
snd (Maybe (param, readEntity) -> Maybe readEntity)
-> ([(param, readEntity)] -> Maybe (param, readEntity))
-> [(param, readEntity)]
-> Maybe readEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(param, readEntity)] -> Maybe (param, readEntity)
forall a. [a] -> Maybe a
Maybe.listToMaybe
      }

  select :: SelectOptions -> Select (param, readEntity)
select =
    AnnotatedSqlMarshaller (param, writeEntity) (param, readEntity)
-> Qualified TableName
-> SelectOptions
-> Select (param, readEntity)
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> Qualified TableName -> SelectOptions -> Select readEntity
Exec.selectMarshalledColumns
      AnnotatedSqlMarshaller (param, writeEntity) (param, readEntity)
marshaller
      (TableDefinition key writeEntity readEntity -> Qualified TableName
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Qualified TableName
Schema.tableName TableDefinition key writeEntity readEntity
tableDef)

  marshaller :: AnnotatedSqlMarshaller (param, writeEntity) (param, readEntity)
marshaller =
    (SqlMarshaller writeEntity readEntity
 -> SqlMarshaller (param, writeEntity) (param, readEntity))
-> AnnotatedSqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller (param, writeEntity) (param, readEntity)
forall readEntityA writeEntityA readEntityB writeEntityB.
(SqlMarshaller readEntityA writeEntityA
 -> SqlMarshaller readEntityB writeEntityB)
-> AnnotatedSqlMarshaller readEntityA writeEntityA
-> AnnotatedSqlMarshaller readEntityB writeEntityB
Marshall.mapSqlMarshaller
      ( \SqlMarshaller writeEntity readEntity
m ->
          (,)
            (param -> readEntity -> (param, readEntity))
-> SqlMarshaller (param, writeEntity) param
-> SqlMarshaller
     (param, writeEntity) (readEntity -> (param, readEntity))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WherePlanner param
-> forall entity. (entity -> param) -> SqlMarshaller entity param
forall param.
WherePlanner param
-> forall entity. (entity -> param) -> SqlMarshaller entity param
paramMarshaller WherePlanner param
wherePlanner (param, writeEntity) -> param
forall a b. (a, b) -> a
fst
            SqlMarshaller
  (param, writeEntity) (readEntity -> (param, readEntity))
-> SqlMarshaller (param, writeEntity) readEntity
-> SqlMarshaller (param, writeEntity) (param, readEntity)
forall a b.
SqlMarshaller (param, writeEntity) (a -> b)
-> SqlMarshaller (param, writeEntity) a
-> SqlMarshaller (param, writeEntity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((param, writeEntity) -> writeEntity)
-> SqlMarshaller writeEntity readEntity
-> SqlMarshaller (param, writeEntity) readEntity
forall parentEntity nestedWriteEntity nestedReadEntity.
(parentEntity -> nestedWriteEntity)
-> SqlMarshaller nestedWriteEntity nestedReadEntity
-> SqlMarshaller parentEntity nestedReadEntity
Marshall.marshallNested (param, writeEntity) -> writeEntity
forall a b. (a, b) -> b
snd SqlMarshaller writeEntity readEntity
m
      )
      (TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
Schema.tableMarshaller TableDefinition key writeEntity readEntity
tableDef)

{- |
  'findAll' builds a planning primitive that finds all the rows from the given
  table where the column value for the provided field matches the plan's input
  parameter. When executed on multiple parameters, all rows are fetched in a
  single query and then associated with their respective inputs after being
  fetched.

@since 1.0.0.0
-}
findAll ::
  Ord param =>
  Schema.TableDefinition key writeEntity readEntity ->
  WherePlanner param ->
  Operation param [readEntity]
findAll :: forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param -> Operation param [readEntity]
findAll TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner =
  TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param [readEntity]
forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param [readEntity]
findAllWithOpts TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner SelectOptions
forall a. Monoid a => a
mempty

{- |
  'findAllWhere' is similar to 'findAll' but allows a 'Expr.BooleanExpr' to be
  specified that is added to the database query to restrict which rows are
  returned.

@since 1.0.0.0
-}
findAllWhere ::
  Ord param =>
  Schema.TableDefinition key writeEntity readEntity ->
  WherePlanner param ->
  Expr.BooleanExpr ->
  Operation param [readEntity]
findAllWhere :: forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param
-> BooleanExpr
-> Operation param [readEntity]
findAllWhere TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner BooleanExpr
cond =
  TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param [readEntity]
forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param [readEntity]
findAllWithOpts TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner (BooleanExpr -> SelectOptions
Exec.where_ BooleanExpr
cond)

{- |
  'findAllWithOpts' is an internal helper used by 'findAll' and 'findAllWhere'.

@since 1.0.0.0
-}
findAllWithOpts ::
  Ord param =>
  Schema.TableDefinition key writeEntity readEntity ->
  WherePlanner param ->
  Exec.SelectOptions ->
  Operation param [readEntity]
findAllWithOpts :: forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param
-> SelectOptions
-> Operation param [readEntity]
findAllWithOpts TableDefinition key writeEntity readEntity
tableDef WherePlanner param
wherePlanner SelectOptions
opts =
  SelectOperation param (param, readEntity) [readEntity]
-> Operation param [readEntity]
forall param row result.
Ord param =>
SelectOperation param row result -> Operation param result
selectOperation SelectOperation param (param, readEntity) [readEntity]
selectOp
 where
  selectOp :: SelectOperation param (param, readEntity) [readEntity]
selectOp =
    SelectOperation
      { selectOne :: param -> Select (param, readEntity)
selectOne = \param
param ->
          SelectOptions -> Select (param, readEntity)
select (SelectOptions
opts SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> BooleanExpr -> SelectOptions
Exec.where_ (WherePlanner param -> param -> BooleanExpr
forall param. WherePlanner param -> param -> BooleanExpr
executeOneWhereCondition WherePlanner param
wherePlanner param
param))
      , selectMany :: NonEmpty param -> Select (param, readEntity)
selectMany = \NonEmpty param
params ->
          SelectOptions -> Select (param, readEntity)
select (SelectOptions
opts SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> BooleanExpr -> SelectOptions
Exec.where_ (WherePlanner param -> NonEmpty param -> BooleanExpr
forall param. WherePlanner param -> NonEmpty param -> BooleanExpr
executeManyWhereCondition WherePlanner param
wherePlanner NonEmpty param
params))
      , explainSelectOne :: Select (param, readEntity)
explainSelectOne =
          SelectOptions -> Select (param, readEntity)
select (SelectOptions
opts SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> BooleanExpr -> SelectOptions
Exec.where_ (WherePlanner param -> BooleanExpr
forall param. WherePlanner param -> BooleanExpr
explainOneWhereCondition WherePlanner param
wherePlanner))
      , explainSelectMany :: Select (param, readEntity)
explainSelectMany =
          SelectOptions -> Select (param, readEntity)
select (SelectOptions
opts SelectOptions -> SelectOptions -> SelectOptions
forall a. Semigroup a => a -> a -> a
<> BooleanExpr -> SelectOptions
Exec.where_ (WherePlanner param -> BooleanExpr
forall param. WherePlanner param -> BooleanExpr
explainManyWhereCondition WherePlanner param
wherePlanner))
      , categorizeRow :: (param, readEntity) -> param
categorizeRow = (param, readEntity) -> param
forall a b. (a, b) -> a
fst
      , produceResult :: [(param, readEntity)] -> [readEntity]
produceResult = ((param, readEntity) -> readEntity)
-> [(param, readEntity)] -> [readEntity]
forall a b. (a -> b) -> [a] -> [b]
map (param, readEntity) -> readEntity
forall a b. (a, b) -> b
snd
      }

  select :: SelectOptions -> Select (param, readEntity)
select =
    AnnotatedSqlMarshaller (param, writeEntity) (param, readEntity)
-> Qualified TableName
-> SelectOptions
-> Select (param, readEntity)
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> Qualified TableName -> SelectOptions -> Select readEntity
Exec.selectMarshalledColumns
      AnnotatedSqlMarshaller (param, writeEntity) (param, readEntity)
marshaller
      (TableDefinition key writeEntity readEntity -> Qualified TableName
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity -> Qualified TableName
Schema.tableName TableDefinition key writeEntity readEntity
tableDef)

  marshaller :: AnnotatedSqlMarshaller (param, writeEntity) (param, readEntity)
marshaller =
    (SqlMarshaller writeEntity readEntity
 -> SqlMarshaller (param, writeEntity) (param, readEntity))
-> AnnotatedSqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller (param, writeEntity) (param, readEntity)
forall readEntityA writeEntityA readEntityB writeEntityB.
(SqlMarshaller readEntityA writeEntityA
 -> SqlMarshaller readEntityB writeEntityB)
-> AnnotatedSqlMarshaller readEntityA writeEntityA
-> AnnotatedSqlMarshaller readEntityB writeEntityB
Marshall.mapSqlMarshaller
      ( \SqlMarshaller writeEntity readEntity
m ->
          (,)
            (param -> readEntity -> (param, readEntity))
-> SqlMarshaller (param, writeEntity) param
-> SqlMarshaller
     (param, writeEntity) (readEntity -> (param, readEntity))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WherePlanner param
-> forall entity. (entity -> param) -> SqlMarshaller entity param
forall param.
WherePlanner param
-> forall entity. (entity -> param) -> SqlMarshaller entity param
paramMarshaller WherePlanner param
wherePlanner (param, writeEntity) -> param
forall a b. (a, b) -> a
fst
            SqlMarshaller
  (param, writeEntity) (readEntity -> (param, readEntity))
-> SqlMarshaller (param, writeEntity) readEntity
-> SqlMarshaller (param, writeEntity) (param, readEntity)
forall a b.
SqlMarshaller (param, writeEntity) (a -> b)
-> SqlMarshaller (param, writeEntity) a
-> SqlMarshaller (param, writeEntity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((param, writeEntity) -> writeEntity)
-> SqlMarshaller writeEntity readEntity
-> SqlMarshaller (param, writeEntity) readEntity
forall parentEntity nestedWriteEntity nestedReadEntity.
(parentEntity -> nestedWriteEntity)
-> SqlMarshaller nestedWriteEntity nestedReadEntity
-> SqlMarshaller parentEntity nestedReadEntity
Marshall.marshallNested (param, writeEntity) -> writeEntity
forall a b. (a, b) -> b
snd SqlMarshaller writeEntity readEntity
m
      )
      (TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall key writeEntity readEntity.
TableDefinition key writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
Schema.tableMarshaller TableDefinition key writeEntity readEntity
tableDef)

{- |
  'stringifyField' arbitrarily re-labels the 'Marshall.SqlType' of a field
  definition as text. It is an internal helper function that is used for
  constructing 'Expr.BooleanExpr' clauses used to generate sql when explaining
  how a plan will be executed. Relabeling the type as 'T.Text' allows us to use
  text values as example inputs in the queries when for explaining plans.

@since 1.0.0.0
-}
stringifyField ::
  Marshall.FieldDefinition nullability a ->
  Marshall.FieldDefinition nullability T.Text
stringifyField :: forall nullability a.
FieldDefinition nullability a -> FieldDefinition nullability Text
stringifyField =
  (SqlType a -> SqlType Text)
-> FieldDefinition nullability a
-> FieldDefinition nullability Text
forall a b nullability.
(SqlType a -> SqlType b)
-> FieldDefinition nullability a -> FieldDefinition nullability b
Marshall.convertField (SqlType Text -> SqlType a -> SqlType Text
forall a b. a -> b -> a
const SqlType Text
Marshall.unboundedText)

{- |
  'SelectOperation' is a helper type for building 'Operation' primitives that
  run 'Ex.cSelect' queries. Specifying the fields of 'SelectOperation' and then
  using the 'selectOperation' function to build an 'Operation' is more
  convenient than building functions to execute the queries that are required
  by the 'Operation' type.

  Note: If you only need to build a custom where clause based on the
  'Operation' parameter, you may want to use a custom 'WherePlanner' with one
  of the existing 'findOne' or 'findAll' functions.

  If you cannot respresent your custom operation using 'SelectOperation' then
  you need to build the 'Operation' value directly yourself.

@since 1.0.0.0
-}
data SelectOperation param row result = SelectOperation
  { forall param row result.
SelectOperation param row result -> param -> Select row
selectOne :: param -> Exec.Select row
  -- ^ 'selectOne' will be called to build the 'Exec.Select' query that should
  -- be run when there is a single input parameter while executing a plan.
  -- Note that the "One-ness" here refers to the single input parameter
  -- rather than the result. See 'produceResult' below for more information
  -- about returning one value vs. many from a 'SelectOperation'.
  , forall param row result.
SelectOperation param row result -> NonEmpty param -> Select row
selectMany :: NonEmpty param -> Exec.Select row
  -- ^ 'selectMany' will be called to build the 'Exec.Select' query that should
  -- be run when there are multiple parameters while executing a plan.
  -- Note that the "Many-ness" here refers to the multiple input parameters
  -- rather than the result. See 'produceResult' below for more information
  -- about returning one value vs. many from a 'SelectOperation'.
  , forall param row result.
SelectOperation param row result -> Select row
explainSelectOne :: Exec.Select row
  -- ^ 'explainSelectOne' should show a representative query of what will
  -- be returned when 'selectOne' is used. No input parameter is available
  -- here to build the query, however, because this value is used to
  -- explain a plan without actually running it.
  , forall param row result.
SelectOperation param row result -> Select row
explainSelectMany :: Exec.Select row
  -- ^ 'explainSelectMany' should show a representative query of what will
  -- be returned when 'selectMany is used. No input parameters are available
  -- here to build the query, however, because this value is used to
  -- explain a plan without actually running it.
  , forall param row result.
SelectOperation param row result -> row -> param
categorizeRow :: row -> param
  -- ^ 'categorizeRow' will be used when a plan is executed with multiple
  -- parameters to determine which input parameter the row should be
  -- associated with.
  , forall param row result.
SelectOperation param row result -> [row] -> result
produceResult :: [row] -> result
  -- ^ 'produceResult' will be used to convert the @row@ type returned by the
  -- 'Exec.Select' queries for the operation input to the @result@ type that is
  -- present as the output of the operation. The input rows will be all the
  -- inputs associated with a single parameter. The @result@ type constructed
  -- here need not be a single value. For instance, 'findAll' uses the list
  -- type as the @result@ type and 'findOne' uses 'Maybe'.
  }

{- |
  'selectOperation' builds a primitive planning 'Operation' using the functions
  given by a 'SelectOperation'. If you are implementing a custom operation that
  runs a select statement, it is probably easier to use this function rather
  than building the 'Operation' functions directly.

@since 1.0.0.0
-}
selectOperation ::
  Ord param =>
  SelectOperation param row result ->
  Operation param result
selectOperation :: forall param row result.
Ord param =>
SelectOperation param row result -> Operation param result
selectOperation SelectOperation param row result
selectOp =
  Operation
    { executeOperationOne :: forall (m :: * -> *).
MonadOrville m =>
param -> m (Either AssertionFailed result)
executeOperationOne = SelectOperation param row result
-> param -> m (Either AssertionFailed result)
forall (m :: * -> *) param row result.
MonadOrville m =>
SelectOperation param row result
-> param -> m (Either AssertionFailed result)
executeSelectOne SelectOperation param row result
selectOp
    , executeOperationMany :: forall (m :: * -> *).
MonadOrville m =>
NonEmpty param -> m (Either AssertionFailed (Many param result))
executeOperationMany = SelectOperation param row result
-> NonEmpty param -> m (Either AssertionFailed (Many param result))
forall param row result (m :: * -> *).
(Ord param, MonadOrville m) =>
SelectOperation param row result
-> NonEmpty param -> m (Either AssertionFailed (Many param result))
executeSelectMany SelectOperation param row result
selectOp
    , explainOperationOne :: Explanation
explainOperationOne = Select row -> Explanation
forall row. Select row -> Explanation
explainSelect (Select row -> Explanation) -> Select row -> Explanation
forall a b. (a -> b) -> a -> b
$ SelectOperation param row result -> Select row
forall param row result.
SelectOperation param row result -> Select row
explainSelectOne SelectOperation param row result
selectOp
    , explainOperationMany :: Explanation
explainOperationMany = Select row -> Explanation
forall row. Select row -> Explanation
explainSelect (Select row -> Explanation) -> Select row -> Explanation
forall a b. (a -> b) -> a -> b
$ SelectOperation param row result -> Select row
forall param row result.
SelectOperation param row result -> Select row
explainSelectMany SelectOperation param row result
selectOp
    }

explainSelect :: Exec.Select row -> Exp.Explanation
explainSelect :: forall row. Select row -> Explanation
explainSelect =
  String -> Explanation
Exp.explainStep (String -> Explanation)
-> (Select row -> String) -> Select row -> Explanation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS8.unpack (ByteString -> String)
-> (Select row -> ByteString) -> Select row -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryExpr -> ByteString
forall sql. SqlExpression sql => sql -> ByteString
RawSql.toExampleBytes (QueryExpr -> ByteString)
-> (Select row -> QueryExpr) -> Select row -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select row -> QueryExpr
forall readEntity. Select readEntity -> QueryExpr
Exec.selectToQueryExpr

{- |
  'executeSelectOne' is an internal helper function that executes a
  'SelectOperation' on a single input parameter.

@since 1.0.0.0
-}
executeSelectOne ::
  Monad.MonadOrville m =>
  SelectOperation param row result ->
  param ->
  m (Either AssertionFailed result)
executeSelectOne :: forall (m :: * -> *) param row result.
MonadOrville m =>
SelectOperation param row result
-> param -> m (Either AssertionFailed result)
executeSelectOne SelectOperation param row result
selectOp param
param =
  result -> Either AssertionFailed result
forall a b. b -> Either a b
Right (result -> Either AssertionFailed result)
-> ([row] -> result) -> [row] -> Either AssertionFailed result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectOperation param row result -> [row] -> result
forall param row result.
SelectOperation param row result -> [row] -> result
produceResult SelectOperation param row result
selectOp
    ([row] -> Either AssertionFailed result)
-> m [row] -> m (Either AssertionFailed result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Select row -> m [row]
forall (m :: * -> *) row. MonadOrville m => Select row -> m [row]
Exec.executeSelect (Select row -> m [row])
-> (param -> Select row) -> param -> m [row]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectOperation param row result -> param -> Select row
forall param row result.
SelectOperation param row result -> param -> Select row
selectOne SelectOperation param row result
selectOp (param -> m [row]) -> param -> m [row]
forall a b. (a -> b) -> a -> b
$ param
param)

{- |
  'executeSelectMany' is an internal helper function that executes a
  'SelectOperation' on multiple input parameters.

@since 1.0.0.0
-}
executeSelectMany ::
  forall param row result m.
  (Ord param, Monad.MonadOrville m) =>
  SelectOperation param row result ->
  NonEmpty param ->
  m (Either AssertionFailed (Many param result))
executeSelectMany :: forall param row result (m :: * -> *).
(Ord param, MonadOrville m) =>
SelectOperation param row result
-> NonEmpty param -> m (Either AssertionFailed (Many param result))
executeSelectMany SelectOperation param row result
selectOp NonEmpty param
params = do
  [row]
rows <- Select row -> m [row]
forall (m :: * -> *) row. MonadOrville m => Select row -> m [row]
Exec.executeSelect (Select row -> m [row])
-> (NonEmpty param -> Select row) -> NonEmpty param -> m [row]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectOperation param row result -> NonEmpty param -> Select row
forall param row result.
SelectOperation param row result -> NonEmpty param -> Select row
selectMany SelectOperation param row result
selectOp (NonEmpty param -> m [row]) -> NonEmpty param -> m [row]
forall a b. (a -> b) -> a -> b
$ NonEmpty param
params

  let
    paramList :: [param]
    paramList :: [param]
paramList = NonEmpty param -> [param]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList NonEmpty param
params

    -- Seed add initial map with an empty seq for every input parameter
    -- to guarantee that each param is a key in the map even if no rows
    -- where returned from the select query for that param.
    emptyRowsMap :: Map.Map param (Seq.Seq a)
    emptyRowsMap :: forall a. Map param (Seq a)
emptyRowsMap =
      [(param, Seq a)] -> Map param (Seq a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        ([(param, Seq a)] -> Map param (Seq a))
-> ([param] -> [(param, Seq a)]) -> [param] -> Map param (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (param -> (param, Seq a)) -> [param] -> [(param, Seq a)]
forall a b. (a -> b) -> [a] -> [b]
map (\param
param -> (param
param, Seq a
forall a. Seq a
Seq.empty))
        ([param] -> Map param (Seq a)) -> [param] -> Map param (Seq a)
forall a b. (a -> b) -> a -> b
$ [param]
paramList

    insertRow :: Map param (Seq row) -> row -> Map param (Seq row)
insertRow Map param (Seq row)
results row
row =
      (Maybe (Seq row) -> Maybe (Seq row))
-> param -> Map param (Seq row) -> Map param (Seq row)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
        (\Maybe (Seq row)
mbRows -> Seq row -> Maybe (Seq row)
forall a. a -> Maybe a
Just (Seq row -> Maybe (Seq row) -> Seq row
forall a. a -> Maybe a -> a
Maybe.fromMaybe Seq row
forall a. Seq a
Seq.empty Maybe (Seq row)
mbRows Seq row -> row -> Seq row
forall a. Seq a -> a -> Seq a
Seq.|> row
row))
        (SelectOperation param row result -> row -> param
forall param row result.
SelectOperation param row result -> row -> param
categorizeRow SelectOperation param row result
selectOp row
row)
        Map param (Seq row)
results

    rowMap :: Map param result
rowMap =
      SelectOperation param row result -> [row] -> result
forall param row result.
SelectOperation param row result -> [row] -> result
produceResult SelectOperation param row result
selectOp ([row] -> result) -> (Seq row -> [row]) -> Seq row -> result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq row -> [row]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList (Seq row -> result) -> Map param (Seq row) -> Map param result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map param (Seq row) -> row -> Map param (Seq row))
-> Map param (Seq row) -> [row] -> Map param (Seq row)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' Map param (Seq row) -> row -> Map param (Seq row)
insertRow Map param (Seq row)
forall a. Map param (Seq a)
emptyRowsMap [row]
rows

    manyRows :: Many param result
manyRows =
      [param] -> (param -> Either NotAKey result) -> Many param result
forall k a. [k] -> (k -> Either NotAKey a) -> Many k a
Many.fromKeys [param]
paramList ((param -> Either NotAKey result) -> Many param result)
-> (param -> Either NotAKey result) -> Many param result
forall a b. (a -> b) -> a -> b
$ \param
param ->
        case param -> Map param result -> Maybe result
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup param
param Map param result
rowMap of
          Maybe result
Nothing ->
            -- Because we seeded the map above with all the input parameters we
            -- can be sure that if we don't find a value in the map here it is
            -- because the function parameter is not one of the original inputs
            -- rather than just an input for which no rows were returned by the
            -- select query.
            NotAKey -> Either NotAKey result
forall a b. a -> Either a b
Left NotAKey
Many.NotAKey
          Just result
row ->
            result -> Either NotAKey result
forall a b. b -> Either a b
Right result
row

  Either AssertionFailed (Many param result)
-> m (Either AssertionFailed (Many param result))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AssertionFailed (Many param result)
 -> m (Either AssertionFailed (Many param result)))
-> (Many param result
    -> Either AssertionFailed (Many param result))
-> Many param result
-> m (Either AssertionFailed (Many param result))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many param result -> Either AssertionFailed (Many param result)
forall a b. b -> Either a b
Right (Many param result
 -> m (Either AssertionFailed (Many param result)))
-> Many param result
-> m (Either AssertionFailed (Many param result))
forall a b. (a -> b) -> a -> b
$ Many param result
manyRows

{- |
  'findSelect' builds a plan 'Operation' where the select that is run does not
  use the input parameters for the plan in any way. The 'executeOperationMany'
  function of the resulting 'Operation' will run the query once and use the
  entire result set as the result each of the input parameters in turn.

@since 1.0.0.0
-}
findSelect :: forall param row. Exec.Select row -> Operation param [row]
findSelect :: forall param row. Select row -> Operation param [row]
findSelect Select row
select =
  let
    executeOne :: Monad.MonadOrville m => param -> m (Either a [row])
    executeOne :: forall (m :: * -> *) a.
MonadOrville m =>
param -> m (Either a [row])
executeOne param
_ =
      [row] -> Either a [row]
forall a b. b -> Either a b
Right ([row] -> Either a [row]) -> m [row] -> m (Either a [row])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Select row -> m [row]
forall (m :: * -> *) row. MonadOrville m => Select row -> m [row]
Exec.executeSelect Select row
select

    executeMany :: Monad.MonadOrville m => NonEmpty param -> m (Either a (Many param [row]))
    executeMany :: forall (m :: * -> *) a.
MonadOrville m =>
NonEmpty param -> m (Either a (Many param [row]))
executeMany NonEmpty param
params = do
      [row]
rows <- Select row -> m [row]
forall (m :: * -> *) row. MonadOrville m => Select row -> m [row]
Exec.executeSelect Select row
select
      Either a (Many param [row]) -> m (Either a (Many param [row]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a (Many param [row]) -> m (Either a (Many param [row])))
-> (Many param [row] -> Either a (Many param [row]))
-> Many param [row]
-> m (Either a (Many param [row]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many param [row] -> Either a (Many param [row])
forall a b. b -> Either a b
Right (Many param [row] -> m (Either a (Many param [row])))
-> Many param [row] -> m (Either a (Many param [row]))
forall a b. (a -> b) -> a -> b
$ [param] -> (param -> Either NotAKey [row]) -> Many param [row]
forall k a. [k] -> (k -> Either NotAKey a) -> Many k a
Many.fromKeys (NonEmpty param -> [param]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList NonEmpty param
params) (Either NotAKey [row] -> param -> Either NotAKey [row]
forall a b. a -> b -> a
const ([row] -> Either NotAKey [row]
forall a b. b -> Either a b
Right [row]
rows))

    selectToSqlString :: Exec.Select readEntity -> String
    selectToSqlString :: forall readEntity. Select readEntity -> String
selectToSqlString =
      ByteString -> String
BS8.unpack
        (ByteString -> String)
-> (Select readEntity -> ByteString) -> Select readEntity -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryExpr -> ByteString
forall sql. SqlExpression sql => sql -> ByteString
RawSql.toExampleBytes
        (QueryExpr -> ByteString)
-> (Select readEntity -> QueryExpr)
-> Select readEntity
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select readEntity -> QueryExpr
forall readEntity. Select readEntity -> QueryExpr
Exec.selectToQueryExpr
  in
    Operation
      { executeOperationOne :: forall (m :: * -> *).
MonadOrville m =>
param -> m (Either AssertionFailed [row])
executeOperationOne = param -> m (Either AssertionFailed [row])
forall (m :: * -> *).
MonadOrville m =>
param -> m (Either AssertionFailed [row])
forall (m :: * -> *) a.
MonadOrville m =>
param -> m (Either a [row])
executeOne
      , executeOperationMany :: forall (m :: * -> *).
MonadOrville m =>
NonEmpty param -> m (Either AssertionFailed (Many param [row]))
executeOperationMany = NonEmpty param -> m (Either AssertionFailed (Many param [row]))
forall (m :: * -> *).
MonadOrville m =>
NonEmpty param -> m (Either AssertionFailed (Many param [row]))
forall (m :: * -> *) a.
MonadOrville m =>
NonEmpty param -> m (Either a (Many param [row]))
executeMany
      , explainOperationOne :: Explanation
explainOperationOne = String -> Explanation
Exp.explainStep (Select row -> String
forall readEntity. Select readEntity -> String
selectToSqlString Select row
select)
      , explainOperationMany :: Explanation
explainOperationMany = String -> Explanation
Exp.explainStep (Select row -> String
forall readEntity. Select readEntity -> String
selectToSqlString Select row
select)
      }