{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

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

This module provides functions for constructing a mapping between Haskell data
types and SQL column schemas. The 'SqlMarshaller' that represents this mapping
can be used to serialize Haskell values both to and from SQL column sets. In
most cases, you construct a 'SqlMarshaller' as part of building your
'Orville.PostgreSQL.Schema.TableDefinition' and Orville handles the rest. In
other cases, you might use a 'SqlMarshaller' with a lower-level Orville
function. For instance, to decode the result set of a custom SQL query.

@since 1.0.0.0
-}
module Orville.PostgreSQL.Marshall.SqlMarshaller
  ( SqlMarshaller
  , AnnotatedSqlMarshaller
  , annotateSqlMarshaller
  , annotateSqlMarshallerEmptyAnnotation
  , unannotatedSqlMarshaller
  , mapSqlMarshaller
  , MarshallerField (Natural, Synthetic)
  , marshallResultFromSql
  , marshallResultFromSqlUsingRowIdExtractor
  , RowIdentityExtractor
  , mkRowIdentityExtractor
  , marshallField
  , marshallSyntheticField
  , marshallReadOnlyField
  , marshallReadOnly
  , marshallNested
  , marshallMaybe
  , marshallPartial
  , prefixMarshaller
  , ReadOnlyColumnOption (IncludeReadOnlyColumns, ExcludeReadOnlyColumns)
  , collectFromField
  , marshallEntityToSetClauses
  , foldMarshallerFields
  , marshallerDerivedColumns
  , marshallerTableConstraints
  , mkRowSource
  , RowSource
  , mapRowSource
  , applyRowSource
  , constRowSource
  , failRowSource
  )
where

import Control.Monad (join)
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import qualified Data.Set as Set

import Orville.PostgreSQL.ErrorDetailLevel (ErrorDetailLevel)
import Orville.PostgreSQL.Execution.ExecutionResult (Column (Column), ExecutionResult, Row (Row))
import qualified Orville.PostgreSQL.Execution.ExecutionResult as Result
import qualified Orville.PostgreSQL.Expr as Expr
import Orville.PostgreSQL.Marshall.FieldDefinition (FieldDefinition, FieldName, FieldNullability (NotNullField, NullableField), asymmetricNullableField, fieldColumnName, fieldName, fieldNameToByteString, fieldNameToColumnName, fieldNullability, fieldTableConstraints, fieldValueFromSqlValue, nullableField, prefixField, setField)
import qualified Orville.PostgreSQL.Marshall.MarshallError as MarshallError
import Orville.PostgreSQL.Marshall.SyntheticField (SyntheticField, nullableSyntheticField, prefixSyntheticField, syntheticFieldAlias, syntheticFieldExpression, syntheticFieldValueFromSqlValue)
import qualified Orville.PostgreSQL.Raw.SqlValue as SqlValue
import qualified Orville.PostgreSQL.Schema.ConstraintDefinition as ConstraintDefinition

{- |
  An 'AnnotatedSqlMarshaller' is a 'SqlMarshaller' that contains extra
  annotations which cannot necessarily be determined from the data in the
  marshaller itself. In particular, it includes the names of fields that can be
  used to identify a row in the database when an error is encountered during
  decoding.

  Normally you will not need to interact with this type directly -- the
  @TableDefinition@ type creates it for you using the information it has about
  the primary key of the table to identify rows in decoding errors. If you are
  executing custom queries directly, you may need to annotate a raw
  'SqlMarshaller' yourself so that rows can be identified. See
  'annotateSqlMarshaller' and 'annotateSqlMarshallerEmptyAnnotation'.

@since 1.0.0.0
-}
data AnnotatedSqlMarshaller writeEntity readEntity = AnnotatedSqlMarshaller
  { forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity -> [FieldName]
rowIdFieldNames :: [FieldName]
  , forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
unannotatedSqlMarshaller :: SqlMarshaller writeEntity readEntity
  }

{- |
  Creates an 'AnnotatedSqlMarshaller' that will use the given column names
  to identify rows in error messages when decoding fails. Any column names
  in the list that are not present in the result set will simply be omitted
  from the error message.

@since 1.0.0.0
-}
annotateSqlMarshaller ::
  [FieldName] ->
  SqlMarshaller writeEntity readEntity ->
  AnnotatedSqlMarshaller writeEntity readEntity
annotateSqlMarshaller :: forall writeEntity readEntity.
[FieldName]
-> SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
annotateSqlMarshaller =
  [FieldName]
-> SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
[FieldName]
-> SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
AnnotatedSqlMarshaller

{- |
  Creates an 'AnnotatedSqlMarshaller' that will identify rows in decoding
  errors by any columns. This is the equivalent of @annotateSqlMarshaller []@.

@since 1.0.0.0
-}
annotateSqlMarshallerEmptyAnnotation ::
  SqlMarshaller writeEntity readEntity ->
  AnnotatedSqlMarshaller writeEntity readEntity
annotateSqlMarshallerEmptyAnnotation :: forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
annotateSqlMarshallerEmptyAnnotation =
  [FieldName]
-> SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
[FieldName]
-> SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
annotateSqlMarshaller []

{- |
  Applies the provided function to a 'SqlMarshaller' that has been annotated,
  preserving the annotations.

@since 1.0.0.0
-}
mapSqlMarshaller ::
  (SqlMarshaller readEntityA writeEntityA -> SqlMarshaller readEntityB writeEntityB) ->
  AnnotatedSqlMarshaller readEntityA writeEntityA ->
  AnnotatedSqlMarshaller readEntityB writeEntityB
mapSqlMarshaller :: forall readEntityA writeEntityA readEntityB writeEntityB.
(SqlMarshaller readEntityA writeEntityA
 -> SqlMarshaller readEntityB writeEntityB)
-> AnnotatedSqlMarshaller readEntityA writeEntityA
-> AnnotatedSqlMarshaller readEntityB writeEntityB
mapSqlMarshaller SqlMarshaller readEntityA writeEntityA
-> SqlMarshaller readEntityB writeEntityB
f (AnnotatedSqlMarshaller [FieldName]
rowIdFields SqlMarshaller readEntityA writeEntityA
marshaller) =
  [FieldName]
-> SqlMarshaller readEntityB writeEntityB
-> AnnotatedSqlMarshaller readEntityB writeEntityB
forall writeEntity readEntity.
[FieldName]
-> SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
AnnotatedSqlMarshaller [FieldName]
rowIdFields (SqlMarshaller readEntityA writeEntityA
-> SqlMarshaller readEntityB writeEntityB
f SqlMarshaller readEntityA writeEntityA
marshaller)

{- |
  'SqlMarshaller' is how we group the lowest-level translation of single fields
  into a higher-level marshalling of full SQL records into Haskell records.
  This is a flexible abstraction that allows us to ultimately model SQL tables
  and work with them as potentially nested Haskell records. We can then
  "marshall" the data as we want to model it in SQL and Haskell.

@since 1.0.0.0
-}
data SqlMarshaller a b where
  -- | Our representation of 'pure' in the 'Applicative' sense.
  MarshallPure :: b -> SqlMarshaller a b
  -- | Representation of application like '<*>' from 'Applicative'.
  MarshallApply :: SqlMarshaller a (b -> c) -> SqlMarshaller a b -> SqlMarshaller a c
  -- | Nest an arbitrary function; this is used when modeling a SQL table as nested Haskell records.
  MarshallNest :: (a -> b) -> SqlMarshaller b c -> SqlMarshaller a c
  -- | Marshall a SQL column using the given 'FieldDefinition'.
  MarshallField :: FieldDefinition nullability a -> SqlMarshaller a a
  -- | Marshall a SQL expression on selecting using the given 'SyntheticField'
  -- to generate selects. SyntheticFields are implicitly read-only, as they
  -- do not represent a column that can be inserted into.
  MarshallSyntheticField :: SyntheticField a -> SqlMarshaller b a
  -- | Tag a maybe-mapped marshaller so we don't map it twice.
  MarshallMaybeTag :: SqlMarshaller (Maybe a) (Maybe b) -> SqlMarshaller (Maybe a) (Maybe b)
  -- | Marshall a column with a possibility of error.
  MarshallPartial :: SqlMarshaller a (Either String b) -> SqlMarshaller a b
  -- | Marshall a column that is read-only, like auto-incrementing ids.
  MarshallReadOnly :: SqlMarshaller a b -> SqlMarshaller c b

instance Functor (SqlMarshaller a) where
  fmap :: forall a b. (a -> b) -> SqlMarshaller a a -> SqlMarshaller a b
fmap a -> b
f SqlMarshaller a a
marsh = SqlMarshaller a (a -> b) -> SqlMarshaller a a -> SqlMarshaller a b
forall a a c.
SqlMarshaller a (a -> c) -> SqlMarshaller a a -> SqlMarshaller a c
MarshallApply ((a -> b) -> SqlMarshaller a (a -> b)
forall b a. b -> SqlMarshaller a b
MarshallPure a -> b
f) SqlMarshaller a a
marsh

instance Applicative (SqlMarshaller a) where
  pure :: forall a. a -> SqlMarshaller a a
pure = a -> SqlMarshaller a a
forall b a. b -> SqlMarshaller a b
MarshallPure
  <*> :: forall a b.
SqlMarshaller a (a -> b) -> SqlMarshaller a a -> SqlMarshaller a b
(<*>) = SqlMarshaller a (a -> b) -> SqlMarshaller a a -> SqlMarshaller a b
forall a a c.
SqlMarshaller a (a -> c) -> SqlMarshaller a a -> SqlMarshaller a c
MarshallApply

{- |
  Returns a list of 'Expr.DerivedColumn' expressions that can be used in a
  select statement to select values from the database for the 'SqlMarshaller'
  decode.

@since 1.0.0.0
-}
marshallerDerivedColumns ::
  SqlMarshaller writeEntity readEntity ->
  [Expr.DerivedColumn]
marshallerDerivedColumns :: forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity -> [DerivedColumn]
marshallerDerivedColumns SqlMarshaller writeEntity readEntity
marshaller =
  let
    collectDerivedColumn ::
      MarshallerField writeEntity ->
      [Expr.DerivedColumn] ->
      [Expr.DerivedColumn]
    collectDerivedColumn :: forall writeEntity.
MarshallerField writeEntity -> [DerivedColumn] -> [DerivedColumn]
collectDerivedColumn MarshallerField writeEntity
entry [DerivedColumn]
columns =
      case MarshallerField writeEntity
entry of
        Natural FieldDefinition nullability a
fieldDef Maybe (writeEntity -> a)
_ ->
          (ValueExpression -> DerivedColumn
Expr.deriveColumn (ValueExpression -> DerivedColumn)
-> (FieldDefinition nullability a -> ValueExpression)
-> FieldDefinition nullability a
-> DerivedColumn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnName -> ValueExpression
Expr.columnReference (ColumnName -> ValueExpression)
-> (FieldDefinition nullability a -> ColumnName)
-> FieldDefinition nullability a
-> ValueExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition nullability a -> ColumnName
forall nullability a. FieldDefinition nullability a -> ColumnName
fieldColumnName (FieldDefinition nullability a -> DerivedColumn)
-> FieldDefinition nullability a -> DerivedColumn
forall a b. (a -> b) -> a -> b
$ FieldDefinition nullability a
fieldDef)
            DerivedColumn -> [DerivedColumn] -> [DerivedColumn]
forall a. a -> [a] -> [a]
: [DerivedColumn]
columns
        Synthetic SyntheticField a
synthField ->
          ValueExpression -> ColumnName -> DerivedColumn
Expr.deriveColumnAs
            (SyntheticField a -> ValueExpression
forall a. SyntheticField a -> ValueExpression
syntheticFieldExpression SyntheticField a
synthField)
            (FieldName -> ColumnName
fieldNameToColumnName (FieldName -> ColumnName) -> FieldName -> ColumnName
forall a b. (a -> b) -> a -> b
$ SyntheticField a -> FieldName
forall a. SyntheticField a -> FieldName
syntheticFieldAlias SyntheticField a
synthField)
            DerivedColumn -> [DerivedColumn] -> [DerivedColumn]
forall a. a -> [a] -> [a]
: [DerivedColumn]
columns
  in
    SqlMarshaller writeEntity readEntity
-> [DerivedColumn]
-> (MarshallerField writeEntity
    -> [DerivedColumn] -> [DerivedColumn])
-> [DerivedColumn]
forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFields SqlMarshaller writeEntity readEntity
marshaller [] MarshallerField writeEntity -> [DerivedColumn] -> [DerivedColumn]
forall writeEntity.
MarshallerField writeEntity -> [DerivedColumn] -> [DerivedColumn]
collectDerivedColumn

{- |
  Returns the table constraints for all the 'FieldDefinition's used in the
  'SqlMarshaller'.

@since 1.0.0.0
-}
marshallerTableConstraints ::
  SqlMarshaller writeEntity readEntity ->
  ConstraintDefinition.TableConstraints
marshallerTableConstraints :: forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity -> TableConstraints
marshallerTableConstraints SqlMarshaller writeEntity readEntity
marshaller =
  let
    collectTableConstraints ::
      MarshallerField writeEntity ->
      ConstraintDefinition.TableConstraints ->
      ConstraintDefinition.TableConstraints
    collectTableConstraints :: forall writeEntity.
MarshallerField writeEntity -> TableConstraints -> TableConstraints
collectTableConstraints MarshallerField writeEntity
entry TableConstraints
constraints =
      case MarshallerField writeEntity
entry of
        Natural FieldDefinition nullability a
fieldDef Maybe (writeEntity -> a)
_ -> TableConstraints
constraints TableConstraints -> TableConstraints -> TableConstraints
forall a. Semigroup a => a -> a -> a
<> FieldDefinition nullability a -> TableConstraints
forall nullability a.
FieldDefinition nullability a -> TableConstraints
fieldTableConstraints FieldDefinition nullability a
fieldDef
        Synthetic SyntheticField a
_synthField -> TableConstraints
constraints
  in
    SqlMarshaller writeEntity readEntity
-> TableConstraints
-> (MarshallerField writeEntity
    -> TableConstraints -> TableConstraints)
-> TableConstraints
forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFields
      SqlMarshaller writeEntity readEntity
marshaller
      TableConstraints
ConstraintDefinition.emptyTableConstraints
      MarshallerField writeEntity -> TableConstraints -> TableConstraints
forall writeEntity.
MarshallerField writeEntity -> TableConstraints -> TableConstraints
collectTableConstraints

{- |
  Represents a primitive entry in a 'SqlMarshaller'. This type is used with
  'foldMarshallerFields' to provided the entry from the marshaller to the
  folding function to be incorporated in the result of the fold.

@since 1.0.0.0
-}
data MarshallerField writeEntity where
  Natural :: FieldDefinition nullability a -> Maybe (writeEntity -> a) -> MarshallerField writeEntity
  Synthetic :: SyntheticField a -> MarshallerField writeEntity

{- |
  A fold function that can be used with 'foldMarshallerFields' to collect
  a value calculated from a 'FieldDefinition' via the given function. The calculated
  value is added to the list of values being built.

  Note: Folds executed with 'collectFromField' ignore 'Synthetic' entries in
  the marshaller. You should only use 'collectFromField' in situations where
  you only care about the actual columns referenced by the marshaller.

@since 1.0.0.0
-}
collectFromField ::
  ReadOnlyColumnOption ->
  (forall nullability a. FieldDefinition nullability a -> result) ->
  MarshallerField entity ->
  [result] ->
  [result]
collectFromField :: forall result entity.
ReadOnlyColumnOption
-> (forall nullability a. FieldDefinition nullability a -> result)
-> MarshallerField entity
-> [result]
-> [result]
collectFromField ReadOnlyColumnOption
readOnlyColumnOption forall nullability a. FieldDefinition nullability a -> result
fromField MarshallerField entity
entry [result]
results =
  case MarshallerField entity
entry of
    Natural FieldDefinition nullability a
fieldDef (Just entity -> a
_) ->
      FieldDefinition nullability a -> result
forall nullability a. FieldDefinition nullability a -> result
fromField FieldDefinition nullability a
fieldDef result -> [result] -> [result]
forall a. a -> [a] -> [a]
: [result]
results
    Natural FieldDefinition nullability a
fieldDef Maybe (entity -> a)
Nothing ->
      case ReadOnlyColumnOption
readOnlyColumnOption of
        ReadOnlyColumnOption
IncludeReadOnlyColumns -> FieldDefinition nullability a -> result
forall nullability a. FieldDefinition nullability a -> result
fromField FieldDefinition nullability a
fieldDef result -> [result] -> [result]
forall a. a -> [a] -> [a]
: [result]
results
        ReadOnlyColumnOption
ExcludeReadOnlyColumns -> [result]
results
    Synthetic SyntheticField a
_ ->
      [result]
results

{- |
  Uses the field definitions in the marshaller to construct SQL expressions
  that will set columns of the field definitions to their corresponding values
  found in the Haskell @writeEntity@ value.

@since 1.0.0.0
-}
marshallEntityToSetClauses ::
  SqlMarshaller writeEntity readEntity ->
  writeEntity ->
  [Expr.SetClause]
marshallEntityToSetClauses :: forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity -> writeEntity -> [SetClause]
marshallEntityToSetClauses SqlMarshaller writeEntity readEntity
marshaller writeEntity
writeEntity =
  SqlMarshaller writeEntity readEntity
-> [SetClause]
-> (MarshallerField writeEntity -> [SetClause] -> [SetClause])
-> [SetClause]
forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFields
    SqlMarshaller writeEntity readEntity
marshaller
    []
    (writeEntity
-> MarshallerField writeEntity -> [SetClause] -> [SetClause]
forall entity.
entity -> MarshallerField entity -> [SetClause] -> [SetClause]
collectSetClauses writeEntity
writeEntity)

{- |
  An internal helper function that collects the 'Expr.SetClause's to
  update all the fields contained in a 'SqlMarshaller'

@since 1.0.0.0
-}
collectSetClauses ::
  entity ->
  MarshallerField entity ->
  [Expr.SetClause] ->
  [Expr.SetClause]
collectSetClauses :: forall entity.
entity -> MarshallerField entity -> [SetClause] -> [SetClause]
collectSetClauses entity
entity MarshallerField entity
entry [SetClause]
clauses =
  case MarshallerField entity
entry of
    Natural FieldDefinition nullability a
fieldDef (Just entity -> a
accessor) ->
      FieldDefinition nullability a -> a -> SetClause
forall nullability a.
FieldDefinition nullability a -> a -> SetClause
setField FieldDefinition nullability a
fieldDef (entity -> a
accessor entity
entity) SetClause -> [SetClause] -> [SetClause]
forall a. a -> [a] -> [a]
: [SetClause]
clauses
    Natural FieldDefinition nullability a
_ Maybe (entity -> a)
Nothing ->
      [SetClause]
clauses
    Synthetic SyntheticField a
_ ->
      [SetClause]
clauses

{- |
  Specifies whether read-only fields should be included when using functions
  such as 'collectFromField'.

@since 1.0.0.0
-}
data ReadOnlyColumnOption
  = IncludeReadOnlyColumns
  | ExcludeReadOnlyColumns

{- |
  'foldMarshallerFields' allows you to consume the 'FieldDefinition's that
  are contained within the 'SqlMarshaller' to process them however is
  required. This can be used to collect the names of all the fields, encode
  them to 'SqlValue.SqlValue', etc.

@since 1.0.0.0
-}
foldMarshallerFields ::
  SqlMarshaller writeEntity readEntity ->
  result ->
  (MarshallerField writeEntity -> result -> result) ->
  result
foldMarshallerFields :: forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFields SqlMarshaller writeEntity readEntity
marshaller =
  SqlMarshaller writeEntity readEntity
-> Maybe (writeEntity -> writeEntity)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
forall entityPart readEntity writeEntity result.
SqlMarshaller entityPart readEntity
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFieldsPart SqlMarshaller writeEntity readEntity
marshaller ((writeEntity -> writeEntity) -> Maybe (writeEntity -> writeEntity)
forall a. a -> Maybe a
Just writeEntity -> writeEntity
forall a. a -> a
id)

{- |
  The internal helper function that actually implements 'foldMarshallerFields'.
  It takes with it a function that extracts the current nesting entity from
  the overall @writeEntity@ that the 'SqlMarshaller' is build on. 'MarshallNest'
  adds more nesting by composing its accessor with the one given here.

@since 1.0.0.0
-}
foldMarshallerFieldsPart ::
  SqlMarshaller entityPart readEntity ->
  Maybe (writeEntity -> entityPart) ->
  result ->
  (MarshallerField writeEntity -> result -> result) ->
  result
foldMarshallerFieldsPart :: forall entityPart readEntity writeEntity result.
SqlMarshaller entityPart readEntity
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFieldsPart SqlMarshaller entityPart readEntity
marshaller Maybe (writeEntity -> entityPart)
getPart result
currentResult MarshallerField writeEntity -> result -> result
addToResult =
  case SqlMarshaller entityPart readEntity
marshaller of
    MarshallPure readEntity
_ ->
      result
currentResult
    MarshallApply SqlMarshaller entityPart (b -> readEntity)
submarshallerA SqlMarshaller entityPart b
submarshallerB ->
      let
        subresultB :: result
subresultB =
          SqlMarshaller entityPart b
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
forall entityPart readEntity writeEntity result.
SqlMarshaller entityPart readEntity
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFieldsPart SqlMarshaller entityPart b
submarshallerB Maybe (writeEntity -> entityPart)
getPart result
currentResult MarshallerField writeEntity -> result -> result
addToResult
      in
        SqlMarshaller entityPart (b -> readEntity)
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
forall entityPart readEntity writeEntity result.
SqlMarshaller entityPart readEntity
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFieldsPart SqlMarshaller entityPart (b -> readEntity)
submarshallerA Maybe (writeEntity -> entityPart)
getPart result
subresultB MarshallerField writeEntity -> result -> result
addToResult
    MarshallNest entityPart -> b
nestingFunction SqlMarshaller b readEntity
submarshaller ->
      SqlMarshaller b readEntity
-> Maybe (writeEntity -> b)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
forall entityPart readEntity writeEntity result.
SqlMarshaller entityPart readEntity
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFieldsPart SqlMarshaller b readEntity
submarshaller (((writeEntity -> entityPart) -> writeEntity -> b)
-> Maybe (writeEntity -> entityPart) -> Maybe (writeEntity -> b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (entityPart -> b
nestingFunction (entityPart -> b)
-> (writeEntity -> entityPart) -> writeEntity -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Maybe (writeEntity -> entityPart)
getPart) result
currentResult MarshallerField writeEntity -> result -> result
addToResult
    MarshallField FieldDefinition nullability entityPart
fieldDefinition ->
      MarshallerField writeEntity -> result -> result
addToResult (FieldDefinition nullability entityPart
-> Maybe (writeEntity -> entityPart) -> MarshallerField writeEntity
forall a b writeEntity.
FieldDefinition a b
-> Maybe (writeEntity -> b) -> MarshallerField writeEntity
Natural FieldDefinition nullability entityPart
fieldDefinition Maybe (writeEntity -> entityPart)
getPart) result
currentResult
    MarshallSyntheticField SyntheticField readEntity
syntheticField ->
      MarshallerField writeEntity -> result -> result
addToResult (SyntheticField readEntity -> MarshallerField writeEntity
forall a writeEntity.
SyntheticField a -> MarshallerField writeEntity
Synthetic SyntheticField readEntity
syntheticField) result
currentResult
    MarshallMaybeTag SqlMarshaller (Maybe a) (Maybe b)
m ->
      SqlMarshaller (Maybe a) (Maybe b)
-> Maybe (writeEntity -> Maybe a)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
forall entityPart readEntity writeEntity result.
SqlMarshaller entityPart readEntity
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFieldsPart SqlMarshaller (Maybe a) (Maybe b)
m Maybe (writeEntity -> entityPart)
Maybe (writeEntity -> Maybe a)
getPart result
currentResult MarshallerField writeEntity -> result -> result
addToResult
    MarshallPartial SqlMarshaller entityPart (Either String readEntity)
m ->
      SqlMarshaller entityPart (Either String readEntity)
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
forall entityPart readEntity writeEntity result.
SqlMarshaller entityPart readEntity
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFieldsPart SqlMarshaller entityPart (Either String readEntity)
m Maybe (writeEntity -> entityPart)
getPart result
currentResult MarshallerField writeEntity -> result -> result
addToResult
    MarshallReadOnly SqlMarshaller a readEntity
m ->
      SqlMarshaller a readEntity
-> Maybe (writeEntity -> a)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
forall entityPart readEntity writeEntity result.
SqlMarshaller entityPart readEntity
-> Maybe (writeEntity -> entityPart)
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFieldsPart SqlMarshaller a readEntity
m Maybe (writeEntity -> a)
forall a. Maybe a
Nothing result
currentResult MarshallerField writeEntity -> result -> result
addToResult

{- |
  Decodes all the rows found in an execution result at once. The first row that
  fails to decode will return the 'MarshallError.MarshallErrorDetails' that
  results, otherwise all decoded rows will be returned.

  Note that this function loads all decoded rows into memory at once, so it
  should only be used with result sets that you know will fit into memory.

@since 1.0.0.0
-}
marshallResultFromSql ::
  ExecutionResult result =>
  ErrorDetailLevel ->
  AnnotatedSqlMarshaller writeEntity readEntity ->
  result ->
  IO (Either MarshallError.MarshallError [readEntity])
marshallResultFromSql :: forall result writeEntity readEntity.
ExecutionResult result =>
ErrorDetailLevel
-> AnnotatedSqlMarshaller writeEntity readEntity
-> result
-> IO (Either MarshallError [readEntity])
marshallResultFromSql ErrorDetailLevel
errorDetailLevel AnnotatedSqlMarshaller writeEntity readEntity
marshallerWithMeta result
result =
  ErrorDetailLevel
-> RowIdentityExtractor
-> SqlMarshaller writeEntity readEntity
-> result
-> IO (Either MarshallError [readEntity])
forall result writeEntity readEntity.
ExecutionResult result =>
ErrorDetailLevel
-> RowIdentityExtractor
-> SqlMarshaller writeEntity readEntity
-> result
-> IO (Either MarshallError [readEntity])
marshallResultFromSqlUsingRowIdExtractor
    ErrorDetailLevel
errorDetailLevel
    ([FieldName] -> result -> RowIdentityExtractor
forall result.
ExecutionResult result =>
[FieldName] -> result -> RowIdentityExtractor
mkRowIdentityExtractor (AnnotatedSqlMarshaller writeEntity readEntity -> [FieldName]
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity -> [FieldName]
rowIdFieldNames AnnotatedSqlMarshaller writeEntity readEntity
marshallerWithMeta) result
result)
    (AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> SqlMarshaller writeEntity readEntity
unannotatedSqlMarshaller AnnotatedSqlMarshaller writeEntity readEntity
marshallerWithMeta)
    result
result

{- |
  Decodes all the rows found in a execution result at once. The first row that
  fails to decode will return the 'MarshallError.MarshallErrorDetails' that
  results, otherwise all decoded rows will be returned. If an error occurs
  while decoding a row, the 'RowIdentityExtractor' will be used to extract
  values to identify the row in the error details.

  Note that this function loads all decoded rows into memory at once, so it
  should only be used with result sets that you know will fit into memory.

@since 1.0.0.0
-}
marshallResultFromSqlUsingRowIdExtractor ::
  ExecutionResult result =>
  ErrorDetailLevel ->
  RowIdentityExtractor ->
  SqlMarshaller writeEntity readEntity ->
  result ->
  IO (Either MarshallError.MarshallError [readEntity])
marshallResultFromSqlUsingRowIdExtractor :: forall result writeEntity readEntity.
ExecutionResult result =>
ErrorDetailLevel
-> RowIdentityExtractor
-> SqlMarshaller writeEntity readEntity
-> result
-> IO (Either MarshallError [readEntity])
marshallResultFromSqlUsingRowIdExtractor ErrorDetailLevel
errorDetailLevel RowIdentityExtractor
rowIdExtractor SqlMarshaller writeEntity readEntity
marshaller result
result = do
  Maybe Row
mbMaxRow <- result -> IO (Maybe Row)
forall result. ExecutionResult result => result -> IO (Maybe Row)
Result.maxRowNumber result
result

  case Maybe Row
mbMaxRow of
    Maybe Row
Nothing ->
      Either MarshallError [readEntity]
-> IO (Either MarshallError [readEntity])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([readEntity] -> Either MarshallError [readEntity]
forall a b. b -> Either a b
Right [])
    Just Row
maxRow -> do
      RowSource readEntity
rowSource <- SqlMarshaller writeEntity readEntity
-> result -> IO (RowSource readEntity)
forall result writeEntity readEntity.
ExecutionResult result =>
SqlMarshaller writeEntity readEntity
-> result -> IO (RowSource readEntity)
mkRowSource SqlMarshaller writeEntity readEntity
marshaller result
result
      (Row -> IO (Either MarshallError readEntity))
-> [Row] -> IO (Either MarshallError [readEntity])
forall a err b.
(a -> IO (Either err b)) -> [a] -> IO (Either err [b])
traverseSequence (ErrorDetailLevel
-> RowSource readEntity
-> RowIdentityExtractor
-> Row
-> IO (Either MarshallError readEntity)
forall readEntity.
ErrorDetailLevel
-> RowSource readEntity
-> RowIdentityExtractor
-> Row
-> IO (Either MarshallError readEntity)
decodeRow ErrorDetailLevel
errorDetailLevel RowSource readEntity
rowSource RowIdentityExtractor
rowIdExtractor) [Int -> Row
Row Int
0 .. Row
maxRow]

traverseSequence :: (a -> IO (Either err b)) -> [a] -> IO (Either err [b])
traverseSequence :: forall a err b.
(a -> IO (Either err b)) -> [a] -> IO (Either err [b])
traverseSequence a -> IO (Either err b)
f =
  [a] -> IO (Either err [b])
go
 where
  go :: [a] -> IO (Either err [b])
go [a]
as =
    case [a]
as of
      [] ->
        Either err [b] -> IO (Either err [b])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([b] -> Either err [b]
forall a b. b -> Either a b
Right [])
      a
a : [a]
rest -> do
        Either err b
eitherB <- a -> IO (Either err b)
f a
a
        case Either err b
eitherB of
          Left err
err ->
            Either err [b] -> IO (Either err [b])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (err -> Either err [b]
forall a b. a -> Either a b
Left err
err)
          Right b
b -> do
            Either err [b]
eitherBS <- [a] -> IO (Either err [b])
go [a]
rest
            case Either err [b]
eitherBS of
              Left err
err ->
                Either err [b] -> IO (Either err [b])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (err -> Either err [b]
forall a b. a -> Either a b
Left err
err)
              Right [b]
bs ->
                Either err [b] -> IO (Either err [b])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([b] -> Either err [b]
forall a b. b -> Either a b
Right (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
bs))

{- |
  Attempts to decode a result set row that has already been fetched from the
  database server into a Haskell value. If the decoding fails, a
  'MarshallError.MarshallError' will be returned.

@since 1.0.0.0
-}
decodeRow ::
  ErrorDetailLevel ->
  RowSource readEntity ->
  RowIdentityExtractor ->
  Row ->
  IO (Either MarshallError.MarshallError readEntity)
decodeRow :: forall readEntity.
ErrorDetailLevel
-> RowSource readEntity
-> RowIdentityExtractor
-> Row
-> IO (Either MarshallError readEntity)
decodeRow ErrorDetailLevel
errorDetailLevel (RowSource Row -> IO (Either MarshallErrorDetails readEntity)
source) (RowIdentityExtractor Row -> IO [(ByteString, SqlValue)]
getRowId) Row
row = do
  Either MarshallErrorDetails readEntity
result <- Row -> IO (Either MarshallErrorDetails readEntity)
source Row
row
  case Either MarshallErrorDetails readEntity
result of
    Left MarshallErrorDetails
err -> do
      [(ByteString, SqlValue)]
rowId <- Row -> IO [(ByteString, SqlValue)]
getRowId Row
row
      Either MarshallError readEntity
-> IO (Either MarshallError readEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MarshallError readEntity
 -> IO (Either MarshallError readEntity))
-> Either MarshallError readEntity
-> IO (Either MarshallError readEntity)
forall a b. (a -> b) -> a -> b
$
        MarshallError -> Either MarshallError readEntity
forall a b. a -> Either a b
Left (MarshallError -> Either MarshallError readEntity)
-> MarshallError -> Either MarshallError readEntity
forall a b. (a -> b) -> a -> b
$
          MarshallError.MarshallError
            { marshallErrorDetailLevel :: ErrorDetailLevel
MarshallError.marshallErrorDetailLevel = ErrorDetailLevel
errorDetailLevel
            , marshallErrorRowIdentifier :: [(ByteString, SqlValue)]
MarshallError.marshallErrorRowIdentifier = [(ByteString, SqlValue)]
rowId
            , marshallErrorDetails :: MarshallErrorDetails
MarshallError.marshallErrorDetails = MarshallErrorDetails
err
            }
    Right readEntity
entity ->
      Either MarshallError readEntity
-> IO (Either MarshallError readEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MarshallError readEntity
 -> IO (Either MarshallError readEntity))
-> Either MarshallError readEntity
-> IO (Either MarshallError readEntity)
forall a b. (a -> b) -> a -> b
$
        readEntity -> Either MarshallError readEntity
forall a b. b -> Either a b
Right readEntity
entity

{- |
  A 'RowSource' can fetch and decode rows from a database result set. Using
  a 'RowSource' gives random access to the rows in the result set, only
  attempting to decode them when they are requested by the user via 'decodeRow'.

  Note that even though the rows are not decoded into Haskell until 'decodeRow'
  is called, all the rows returned from the query are held in memory on the
  client waiting to be decoded until the 'RowSource' is garbage collected.
  As such, you can't use 'RowSource' (alone) to achieve any form of streaming
  or pagination of rows between the database server and the client.

@since 1.0.0.0
-}
newtype RowSource readEntity
  = RowSource (Row -> IO (Either MarshallError.MarshallErrorDetails readEntity))

instance Functor RowSource where
  fmap :: forall a b. (a -> b) -> RowSource a -> RowSource b
fmap = (a -> b) -> RowSource a -> RowSource b
forall a b. (a -> b) -> RowSource a -> RowSource b
mapRowSource

instance Applicative RowSource where
  pure :: forall a. a -> RowSource a
pure = a -> RowSource a
forall a. a -> RowSource a
constRowSource
  <*> :: forall a b. RowSource (a -> b) -> RowSource a -> RowSource b
(<*>) = RowSource (a -> b) -> RowSource a -> RowSource b
forall a b. RowSource (a -> b) -> RowSource a -> RowSource b
applyRowSource

{- |
  Adds a function to the decoding proocess to transform the value returned
  by a 'RowSource'.

@since 1.0.0.0
-}
mapRowSource :: (a -> b) -> RowSource a -> RowSource b
mapRowSource :: forall a b. (a -> b) -> RowSource a -> RowSource b
mapRowSource a -> b
f (RowSource Row -> IO (Either MarshallErrorDetails a)
decodeA) =
  (Row -> IO (Either MarshallErrorDetails b)) -> RowSource b
forall readEntity.
(Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
RowSource ((Row -> IO (Either MarshallErrorDetails b)) -> RowSource b)
-> (Row -> IO (Either MarshallErrorDetails b)) -> RowSource b
forall a b. (a -> b) -> a -> b
$ \Row
row -> (Either MarshallErrorDetails a -> Either MarshallErrorDetails b)
-> IO (Either MarshallErrorDetails a)
-> IO (Either MarshallErrorDetails b)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> Either MarshallErrorDetails a -> Either MarshallErrorDetails b
forall a b.
(a -> b)
-> Either MarshallErrorDetails a -> Either MarshallErrorDetails b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Row -> IO (Either MarshallErrorDetails a)
decodeA Row
row)

{- |
  Creates a 'RowSource' that always returns the value given, rather than
  attempting to access the result set and decoding anything.

@since 1.0.0.0
-}
constRowSource :: readEntity -> RowSource readEntity
constRowSource :: forall a. a -> RowSource a
constRowSource =
  (Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
forall readEntity.
(Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
RowSource ((Row -> IO (Either MarshallErrorDetails readEntity))
 -> RowSource readEntity)
-> (readEntity
    -> Row -> IO (Either MarshallErrorDetails readEntity))
-> readEntity
-> RowSource readEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either MarshallErrorDetails readEntity)
-> Row -> IO (Either MarshallErrorDetails readEntity)
forall a b. a -> b -> a
const (IO (Either MarshallErrorDetails readEntity)
 -> Row -> IO (Either MarshallErrorDetails readEntity))
-> (readEntity -> IO (Either MarshallErrorDetails readEntity))
-> readEntity
-> Row
-> IO (Either MarshallErrorDetails readEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either MarshallErrorDetails readEntity
-> IO (Either MarshallErrorDetails readEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MarshallErrorDetails readEntity
 -> IO (Either MarshallErrorDetails readEntity))
-> (readEntity -> Either MarshallErrorDetails readEntity)
-> readEntity
-> IO (Either MarshallErrorDetails readEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. readEntity -> Either MarshallErrorDetails readEntity
forall a b. b -> Either a b
Right

{- |
  Applies a function that will be decoded from the result set to another
  value decoded from the result set.

@since 1.0.0.0
-}
applyRowSource :: RowSource (a -> b) -> RowSource a -> RowSource b
applyRowSource :: forall a b. RowSource (a -> b) -> RowSource a -> RowSource b
applyRowSource (RowSource Row -> IO (Either MarshallErrorDetails (a -> b))
decodeAtoB) (RowSource Row -> IO (Either MarshallErrorDetails a)
decodeA) =
  (Row -> IO (Either MarshallErrorDetails b)) -> RowSource b
forall readEntity.
(Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
RowSource ((Row -> IO (Either MarshallErrorDetails b)) -> RowSource b)
-> (Row -> IO (Either MarshallErrorDetails b)) -> RowSource b
forall a b. (a -> b) -> a -> b
$ \Row
row -> do
    Either MarshallErrorDetails (a -> b)
eitherAToB <- Row -> IO (Either MarshallErrorDetails (a -> b))
decodeAtoB Row
row

    case Either MarshallErrorDetails (a -> b)
eitherAToB of
      Left MarshallErrorDetails
err ->
        Either MarshallErrorDetails b -> IO (Either MarshallErrorDetails b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MarshallErrorDetails -> Either MarshallErrorDetails b
forall a b. a -> Either a b
Left MarshallErrorDetails
err)
      Right a -> b
aToB -> do
        Either MarshallErrorDetails a
eitherA <- Row -> IO (Either MarshallErrorDetails a)
decodeA Row
row
        Either MarshallErrorDetails b -> IO (Either MarshallErrorDetails b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a -> b)
-> Either MarshallErrorDetails a -> Either MarshallErrorDetails b
forall a b.
(a -> b)
-> Either MarshallErrorDetails a -> Either MarshallErrorDetails b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
aToB Either MarshallErrorDetails a
eitherA)

{- |
  Creates a 'RowSource' that will always fail to decode by returning the
  provided error. This can be used in cases where a 'RowSource' must
  be provided but it is already known at run time that decoding is impossible.
  For instance, this is used internally when a 'FieldDefinition' references
  a column that does not exist in the result set.

@since 1.0.0.0
-}
failRowSource :: MarshallError.MarshallErrorDetails -> RowSource a
failRowSource :: forall a. MarshallErrorDetails -> RowSource a
failRowSource =
  (Row -> IO (Either MarshallErrorDetails a)) -> RowSource a
forall readEntity.
(Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
RowSource ((Row -> IO (Either MarshallErrorDetails a)) -> RowSource a)
-> (MarshallErrorDetails
    -> Row -> IO (Either MarshallErrorDetails a))
-> MarshallErrorDetails
-> RowSource a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either MarshallErrorDetails a)
-> Row -> IO (Either MarshallErrorDetails a)
forall a b. a -> b -> a
const (IO (Either MarshallErrorDetails a)
 -> Row -> IO (Either MarshallErrorDetails a))
-> (MarshallErrorDetails -> IO (Either MarshallErrorDetails a))
-> MarshallErrorDetails
-> Row
-> IO (Either MarshallErrorDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either MarshallErrorDetails a -> IO (Either MarshallErrorDetails a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MarshallErrorDetails a
 -> IO (Either MarshallErrorDetails a))
-> (MarshallErrorDetails -> Either MarshallErrorDetails a)
-> MarshallErrorDetails
-> IO (Either MarshallErrorDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarshallErrorDetails -> Either MarshallErrorDetails a
forall a b. a -> Either a b
Left

{- |
  Uses the 'SqlMarshaller' given to build a 'RowSource' that will decode
  from the given result set. The returned 'RowSource' can then be used to
  decode rows as desired by the user. Note that the entire result set is
  held in memory for potential decoding until the 'RowSource' is garbage
  collected.

@since 1.0.0.0
-}
mkRowSource ::
  ExecutionResult result =>
  SqlMarshaller writeEntity readEntity ->
  result ->
  IO (RowSource readEntity)
mkRowSource :: forall result writeEntity readEntity.
ExecutionResult result =>
SqlMarshaller writeEntity readEntity
-> result -> IO (RowSource readEntity)
mkRowSource SqlMarshaller writeEntity readEntity
marshaller result
result = do
  Map ByteString Column
columnMap <- result -> IO (Map ByteString Column)
forall result.
ExecutionResult result =>
result -> IO (Map ByteString Column)
prepareColumnMap result
result

  let
    mkSource :: SqlMarshaller a b -> RowSource b
    mkSource :: forall a b. SqlMarshaller a b -> RowSource b
mkSource SqlMarshaller a b
marshallerPart =
      -- Note, this case statement is evaluated before the row argument is
      -- ever passed to a 'RowSource' to ensure that a single 'RowSource'
      -- operation is build and re-used when decoding many rows.
      case SqlMarshaller a b
marshallerPart of
        MarshallPure b
readEntity ->
          b -> RowSource b
forall a. a -> RowSource a
constRowSource b
readEntity
        MarshallApply SqlMarshaller a (b -> b)
marshallAToB SqlMarshaller a b
marshallA ->
          SqlMarshaller a (b -> b) -> RowSource (b -> b)
forall a b. SqlMarshaller a b -> RowSource b
mkSource SqlMarshaller a (b -> b)
marshallAToB RowSource (b -> b) -> RowSource b -> RowSource b
forall a b. RowSource (a -> b) -> RowSource a -> RowSource b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlMarshaller a b -> RowSource b
forall a b. SqlMarshaller a b -> RowSource b
mkSource SqlMarshaller a b
marshallA
        MarshallNest a -> b
_ SqlMarshaller b b
someMarshaller ->
          SqlMarshaller b b -> RowSource b
forall a b. SqlMarshaller a b -> RowSource b
mkSource SqlMarshaller b b
someMarshaller
        MarshallField FieldDefinition nullability a
fieldDef ->
          FieldName
-> (SqlValue -> Either String b)
-> Map ByteString Column
-> result
-> RowSource b
forall result a.
ExecutionResult result =>
FieldName
-> (SqlValue -> Either String a)
-> Map ByteString Column
-> result
-> RowSource a
mkFieldNameSource
            (FieldDefinition nullability a -> FieldName
forall nullability a. FieldDefinition nullability a -> FieldName
fieldName FieldDefinition nullability a
fieldDef)
            (FieldDefinition nullability b -> SqlValue -> Either String b
forall nullability a.
FieldDefinition nullability a -> SqlValue -> Either String a
fieldValueFromSqlValue FieldDefinition nullability a
FieldDefinition nullability b
fieldDef)
            Map ByteString Column
columnMap
            result
result
        MarshallSyntheticField SyntheticField b
syntheticField ->
          FieldName
-> (SqlValue -> Either String b)
-> Map ByteString Column
-> result
-> RowSource b
forall result a.
ExecutionResult result =>
FieldName
-> (SqlValue -> Either String a)
-> Map ByteString Column
-> result
-> RowSource a
mkFieldNameSource
            (SyntheticField b -> FieldName
forall a. SyntheticField a -> FieldName
syntheticFieldAlias SyntheticField b
syntheticField)
            (SyntheticField b -> SqlValue -> Either String b
forall a. SyntheticField a -> SqlValue -> Either String a
syntheticFieldValueFromSqlValue SyntheticField b
syntheticField)
            Map ByteString Column
columnMap
            result
result
        MarshallMaybeTag SqlMarshaller (Maybe a) (Maybe b)
m ->
          SqlMarshaller (Maybe a) b -> RowSource b
forall a b. SqlMarshaller a b -> RowSource b
mkSource SqlMarshaller (Maybe a) b
SqlMarshaller (Maybe a) (Maybe b)
m
        MarshallPartial SqlMarshaller a (Either String b)
m ->
          let
            fieldNames :: [FieldName]
fieldNames =
              SqlMarshaller a (Either String b)
-> [FieldName]
-> (MarshallerField a -> [FieldName] -> [FieldName])
-> [FieldName]
forall writeEntity readEntity result.
SqlMarshaller writeEntity readEntity
-> result
-> (MarshallerField writeEntity -> result -> result)
-> result
foldMarshallerFields SqlMarshaller a (Either String b)
m [] ((MarshallerField a -> [FieldName] -> [FieldName]) -> [FieldName])
-> (MarshallerField a -> [FieldName] -> [FieldName]) -> [FieldName]
forall a b. (a -> b) -> a -> b
$ \MarshallerField a
marshallerField [FieldName]
names ->
                case MarshallerField a
marshallerField of
                  Natural FieldDefinition nullability a
field Maybe (a -> a)
_ ->
                    FieldDefinition nullability a -> FieldName
forall nullability a. FieldDefinition nullability a -> FieldName
fieldName FieldDefinition nullability a
field FieldName -> [FieldName] -> [FieldName]
forall a. a -> [a] -> [a]
: [FieldName]
names
                  Synthetic SyntheticField a
field ->
                    SyntheticField a -> FieldName
forall a. SyntheticField a -> FieldName
syntheticFieldAlias SyntheticField a
field FieldName -> [FieldName] -> [FieldName]
forall a. a -> [a] -> [a]
: [FieldName]
names
          in
            [FieldName]
-> Map ByteString Column
-> result
-> RowSource (Either String b)
-> RowSource b
forall result readEntity.
ExecutionResult result =>
[FieldName]
-> Map ByteString Column
-> result
-> RowSource (Either String readEntity)
-> RowSource readEntity
partialRowSource [FieldName]
fieldNames Map ByteString Column
columnMap result
result (SqlMarshaller a (Either String b) -> RowSource (Either String b)
forall a b. SqlMarshaller a b -> RowSource b
mkSource SqlMarshaller a (Either String b)
m)
        MarshallReadOnly SqlMarshaller a b
m ->
          SqlMarshaller a b -> RowSource b
forall a b. SqlMarshaller a b -> RowSource b
mkSource SqlMarshaller a b
m

  RowSource readEntity -> IO (RowSource readEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RowSource readEntity -> IO (RowSource readEntity))
-> (SqlMarshaller writeEntity readEntity -> RowSource readEntity)
-> SqlMarshaller writeEntity readEntity
-> IO (RowSource readEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlMarshaller writeEntity readEntity -> RowSource readEntity
forall a b. SqlMarshaller a b -> RowSource b
mkSource (SqlMarshaller writeEntity readEntity -> IO (RowSource readEntity))
-> SqlMarshaller writeEntity readEntity
-> IO (RowSource readEntity)
forall a b. (a -> b) -> a -> b
$ SqlMarshaller writeEntity readEntity
marshaller

partialRowSource ::
  ExecutionResult result =>
  [FieldName] ->
  Map.Map B8.ByteString Column ->
  result ->
  RowSource (Either String readEntity) ->
  RowSource readEntity
partialRowSource :: forall result readEntity.
ExecutionResult result =>
[FieldName]
-> Map ByteString Column
-> result
-> RowSource (Either String readEntity)
-> RowSource readEntity
partialRowSource [FieldName]
fieldNames Map ByteString Column
columnMap result
result (RowSource Row -> IO (Either MarshallErrorDetails (Either String readEntity))
f) =
  (Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
forall readEntity.
(Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
RowSource ((Row -> IO (Either MarshallErrorDetails readEntity))
 -> RowSource readEntity)
-> (Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
forall a b. (a -> b) -> a -> b
$ \Row
row -> do
    Either MarshallErrorDetails (Either String readEntity)
partialResult <- Row -> IO (Either MarshallErrorDetails (Either String readEntity))
f Row
row
    case Either MarshallErrorDetails (Either String readEntity)
partialResult of
      Left MarshallErrorDetails
marshallError ->
        Either MarshallErrorDetails readEntity
-> IO (Either MarshallErrorDetails readEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MarshallErrorDetails readEntity
 -> IO (Either MarshallErrorDetails readEntity))
-> Either MarshallErrorDetails readEntity
-> IO (Either MarshallErrorDetails readEntity)
forall a b. (a -> b) -> a -> b
$ MarshallErrorDetails -> Either MarshallErrorDetails readEntity
forall a b. a -> Either a b
Left MarshallErrorDetails
marshallError
      Right (Left String
errorMessage) -> do
        let
          columnNames :: [ByteString]
columnNames =
            (FieldName -> ByteString) -> [FieldName] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map FieldName -> ByteString
fieldNameToByteString [FieldName]
fieldNames

          lookupValue :: ByteString -> IO (ByteString, SqlValue)
lookupValue ByteString
columnName =
            case ByteString -> Map ByteString Column -> Maybe Column
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
columnName Map ByteString Column
columnMap of
              Maybe Column
Nothing ->
                (ByteString, SqlValue) -> IO (ByteString, SqlValue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
columnName, SqlValue
SqlValue.sqlNull)
              Just Column
columnNumber -> do
                SqlValue
value <- result -> Row -> Column -> IO SqlValue
forall result.
ExecutionResult result =>
result -> Row -> Column -> IO SqlValue
Result.getValue result
result Row
row Column
columnNumber
                (ByteString, SqlValue) -> IO (ByteString, SqlValue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
columnName, SqlValue
value)

        [(ByteString, SqlValue)]
values <- (ByteString -> IO (ByteString, SqlValue))
-> [ByteString] -> IO [(ByteString, SqlValue)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ByteString -> IO (ByteString, SqlValue)
lookupValue [ByteString]
columnNames

        Either MarshallErrorDetails readEntity
-> IO (Either MarshallErrorDetails readEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MarshallErrorDetails readEntity
 -> IO (Either MarshallErrorDetails readEntity))
-> (DecodingErrorDetails -> Either MarshallErrorDetails readEntity)
-> DecodingErrorDetails
-> IO (Either MarshallErrorDetails readEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarshallErrorDetails -> Either MarshallErrorDetails readEntity
forall a b. a -> Either a b
Left (MarshallErrorDetails -> Either MarshallErrorDetails readEntity)
-> (DecodingErrorDetails -> MarshallErrorDetails)
-> DecodingErrorDetails
-> Either MarshallErrorDetails readEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingErrorDetails -> MarshallErrorDetails
MarshallError.DecodingError (DecodingErrorDetails
 -> IO (Either MarshallErrorDetails readEntity))
-> DecodingErrorDetails
-> IO (Either MarshallErrorDetails readEntity)
forall a b. (a -> b) -> a -> b
$
          MarshallError.DecodingErrorDetails
            { decodingErrorValues :: [(ByteString, SqlValue)]
MarshallError.decodingErrorValues = [(ByteString, SqlValue)]
values
            , decodingErrorMessage :: String
MarshallError.decodingErrorMessage = String
errorMessage
            }
      Right (Right readEntity
entity) ->
        Either MarshallErrorDetails readEntity
-> IO (Either MarshallErrorDetails readEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MarshallErrorDetails readEntity
 -> IO (Either MarshallErrorDetails readEntity))
-> Either MarshallErrorDetails readEntity
-> IO (Either MarshallErrorDetails readEntity)
forall a b. (a -> b) -> a -> b
$ readEntity -> Either MarshallErrorDetails readEntity
forall a b. b -> Either a b
Right readEntity
entity

{- |
  Builds a 'RowSource' that will retrieve and decode the name field from
  the result.

@since 1.0.0.0
-}
mkFieldNameSource ::
  ExecutionResult result =>
  FieldName ->
  (SqlValue.SqlValue -> Either String a) ->
  Map.Map B8.ByteString Column ->
  result ->
  RowSource a
mkFieldNameSource :: forall result a.
ExecutionResult result =>
FieldName
-> (SqlValue -> Either String a)
-> Map ByteString Column
-> result
-> RowSource a
mkFieldNameSource FieldName
sourceFieldName SqlValue -> Either String a
fromSqlValue Map ByteString Column
columnMap result
result =
  case ByteString -> Map ByteString Column -> Maybe Column
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FieldName -> ByteString
fieldNameToByteString FieldName
sourceFieldName) Map ByteString Column
columnMap of
    Just Column
columnNumber ->
      FieldName
-> (SqlValue -> Either String a) -> result -> Column -> RowSource a
forall result a.
ExecutionResult result =>
FieldName
-> (SqlValue -> Either String a) -> result -> Column -> RowSource a
mkColumnRowSource FieldName
sourceFieldName SqlValue -> Either String a
fromSqlValue result
result Column
columnNumber
    Maybe Column
Nothing ->
      MarshallErrorDetails -> RowSource a
forall a. MarshallErrorDetails -> RowSource a
failRowSource (MarshallErrorDetails -> RowSource a)
-> (MissingColumnErrorDetails -> MarshallErrorDetails)
-> MissingColumnErrorDetails
-> RowSource a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MissingColumnErrorDetails -> MarshallErrorDetails
MarshallError.MissingColumnError (MissingColumnErrorDetails -> RowSource a)
-> MissingColumnErrorDetails -> RowSource a
forall a b. (a -> b) -> a -> b
$
        MarshallError.MissingColumnErrorDetails
          { missingColumnName :: ByteString
MarshallError.missingColumnName = FieldName -> ByteString
fieldNameToByteString FieldName
sourceFieldName
          , actualColumnNames :: Set ByteString
MarshallError.actualColumnNames = Map ByteString Column -> Set ByteString
forall k a. Map k a -> Set k
Map.keysSet Map ByteString Column
columnMap
          }

{- |
  An internal helper function that finds all the column names in a result set
  and associates them with the respective column numbers for easier lookup.

@since 1.0.0.0
-}
prepareColumnMap ::
  ExecutionResult result =>
  result ->
  IO (Map.Map B8.ByteString Column)
prepareColumnMap :: forall result.
ExecutionResult result =>
result -> IO (Map ByteString Column)
prepareColumnMap result
result = do
  Maybe Column
mbMaxColumn <- result -> IO (Maybe Column)
forall result.
ExecutionResult result =>
result -> IO (Maybe Column)
Result.maxColumnNumber result
result

  let
    mkNameEntry :: Column -> IO (Maybe (ByteString, Column))
mkNameEntry Column
columnNumber = do
      Maybe ByteString
mbColumnName <- result -> Column -> IO (Maybe ByteString)
forall result.
ExecutionResult result =>
result -> Column -> IO (Maybe ByteString)
Result.columnName result
result Column
columnNumber

      Maybe (ByteString, Column) -> IO (Maybe (ByteString, Column))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ByteString, Column) -> IO (Maybe (ByteString, Column)))
-> Maybe (ByteString, Column) -> IO (Maybe (ByteString, Column))
forall a b. (a -> b) -> a -> b
$
        case Maybe ByteString
mbColumnName of
          Just ByteString
name ->
            (ByteString, Column) -> Maybe (ByteString, Column)
forall a. a -> Maybe a
Just (ByteString
name, Column
columnNumber)
          Maybe ByteString
Nothing ->
            Maybe (ByteString, Column)
forall a. Maybe a
Nothing

  case Maybe Column
mbMaxColumn of
    Maybe Column
Nothing ->
      Map ByteString Column -> IO (Map ByteString Column)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map ByteString Column
forall k a. Map k a
Map.empty
    Just Column
maxColumn -> do
      [Maybe (ByteString, Column)]
entries <- (Column -> IO (Maybe (ByteString, Column)))
-> [Column] -> IO [Maybe (ByteString, Column)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Column -> IO (Maybe (ByteString, Column))
mkNameEntry [Int -> Column
Column Int
0 .. Column
maxColumn]
      Map ByteString Column -> IO (Map ByteString Column)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ByteString Column -> IO (Map ByteString Column))
-> Map ByteString Column -> IO (Map ByteString Column)
forall a b. (a -> b) -> a -> b
$ [(ByteString, Column)] -> Map ByteString Column
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Maybe (ByteString, Column)] -> [(ByteString, Column)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (ByteString, Column)]
entries)

{- |
  A internal helper function for to build a 'RowSource' that retrieves and
  decodes a single column value form the result set.

@since 1.0.0.0
-}
mkColumnRowSource ::
  ExecutionResult result =>
  FieldName ->
  (SqlValue.SqlValue -> Either String a) ->
  result ->
  Column ->
  RowSource a
mkColumnRowSource :: forall result a.
ExecutionResult result =>
FieldName
-> (SqlValue -> Either String a) -> result -> Column -> RowSource a
mkColumnRowSource FieldName
sourceFieldName SqlValue -> Either String a
fromSqlValue result
result Column
column =
  (Row -> IO (Either MarshallErrorDetails a)) -> RowSource a
forall readEntity.
(Row -> IO (Either MarshallErrorDetails readEntity))
-> RowSource readEntity
RowSource ((Row -> IO (Either MarshallErrorDetails a)) -> RowSource a)
-> (Row -> IO (Either MarshallErrorDetails a)) -> RowSource a
forall a b. (a -> b) -> a -> b
$ \Row
row -> do
    SqlValue
sqlValue <- result -> Row -> Column -> IO SqlValue
forall result.
ExecutionResult result =>
result -> Row -> Column -> IO SqlValue
Result.getValue result
result Row
row Column
column

    case SqlValue -> Either String a
fromSqlValue SqlValue
sqlValue of
      Right a
value ->
        Either MarshallErrorDetails a -> IO (Either MarshallErrorDetails a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either MarshallErrorDetails a
forall a b. b -> Either a b
Right a
value)
      Left String
err ->
        let
          details :: DecodingErrorDetails
details =
            MarshallError.DecodingErrorDetails
              { decodingErrorValues :: [(ByteString, SqlValue)]
MarshallError.decodingErrorValues = [(FieldName -> ByteString
fieldNameToByteString FieldName
sourceFieldName, SqlValue
sqlValue)]
              , decodingErrorMessage :: String
MarshallError.decodingErrorMessage = String
err
              }
        in
          Either MarshallErrorDetails a -> IO (Either MarshallErrorDetails a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MarshallErrorDetails -> Either MarshallErrorDetails a
forall a b. a -> Either a b
Left (MarshallErrorDetails -> Either MarshallErrorDetails a)
-> MarshallErrorDetails -> Either MarshallErrorDetails a
forall a b. (a -> b) -> a -> b
$ DecodingErrorDetails -> MarshallErrorDetails
MarshallError.DecodingError DecodingErrorDetails
details)

{- |
  A 'RowIdentityExtractor' is used to retrieve identifying information for a
  row when a 'MarshallError.MarshallError' occurs reading it from the database.

  You should only need to worry about this type if you're using
  'marshallResultFromSqlUsingRowIdExtractor' and need to manually provide it.
  When possible, it's easier to annotate a 'SqlMarshaller' with the field names
  you would like rows to be identified by and then use 'marshallResultFromSql'
  instead.

@since 1.0.0.0
-}
newtype RowIdentityExtractor
  = RowIdentityExtractor (Row -> IO [(B8.ByteString, SqlValue.SqlValue)])

{- |
  Constructs a 'RowIdentityExtractor' that will extract values for the given
  fields from the result set to identify rows in decoding errors. Any of the
  named fields that are missing from the result set will not be included in the
  extracted row identity.

@since 1.0.0.0
-}
mkRowIdentityExtractor ::
  ExecutionResult result =>
  [FieldName] ->
  result ->
  RowIdentityExtractor
mkRowIdentityExtractor :: forall result.
ExecutionResult result =>
[FieldName] -> result -> RowIdentityExtractor
mkRowIdentityExtractor [FieldName]
fields result
result =
  (Row -> IO [(ByteString, SqlValue)]) -> RowIdentityExtractor
RowIdentityExtractor ((Row -> IO [(ByteString, SqlValue)]) -> RowIdentityExtractor)
-> (Row -> IO [(ByteString, SqlValue)]) -> RowIdentityExtractor
forall a b. (a -> b) -> a -> b
$ \Row
row -> do
    let
      fieldNameSet :: Set ByteString
fieldNameSet =
        [ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
Set.fromList
          ([ByteString] -> Set ByteString)
-> ([FieldName] -> [ByteString]) -> [FieldName] -> Set ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName -> ByteString) -> [FieldName] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldName -> ByteString
fieldNameToByteString
          ([FieldName] -> Set ByteString) -> [FieldName] -> Set ByteString
forall a b. (a -> b) -> a -> b
$ [FieldName]
fields

      getIdentityValue :: Column -> IO (Maybe (ByteString, SqlValue))
getIdentityValue Column
columnNumber = do
        Maybe ByteString
mbColumnName <- result -> Column -> IO (Maybe ByteString)
forall result.
ExecutionResult result =>
result -> Column -> IO (Maybe ByteString)
Result.columnName result
result Column
columnNumber

        case Maybe ByteString
mbColumnName of
          Just ByteString
name | ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ByteString
name Set ByteString
fieldNameSet -> do
            SqlValue
value <- result -> Row -> Column -> IO SqlValue
forall result.
ExecutionResult result =>
result -> Row -> Column -> IO SqlValue
Result.getValue result
result Row
row Column
columnNumber
            Maybe (ByteString, SqlValue) -> IO (Maybe (ByteString, SqlValue))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ByteString, SqlValue) -> IO (Maybe (ByteString, SqlValue)))
-> Maybe (ByteString, SqlValue)
-> IO (Maybe (ByteString, SqlValue))
forall a b. (a -> b) -> a -> b
$ (ByteString, SqlValue) -> Maybe (ByteString, SqlValue)
forall a. a -> Maybe a
Just (ByteString
name, SqlValue
value)
          Maybe ByteString
_ ->
            Maybe (ByteString, SqlValue) -> IO (Maybe (ByteString, SqlValue))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ByteString, SqlValue)
forall a. Maybe a
Nothing

    Maybe Column
mbMaxColumn <- result -> IO (Maybe Column)
forall result.
ExecutionResult result =>
result -> IO (Maybe Column)
Result.maxColumnNumber result
result

    case Maybe Column
mbMaxColumn of
      Maybe Column
Nothing ->
        [(ByteString, SqlValue)] -> IO [(ByteString, SqlValue)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just Column
maxColumn ->
        ([Maybe (ByteString, SqlValue)] -> [(ByteString, SqlValue)])
-> IO [Maybe (ByteString, SqlValue)] -> IO [(ByteString, SqlValue)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (ByteString, SqlValue)] -> [(ByteString, SqlValue)]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe (ByteString, SqlValue)] -> IO [(ByteString, SqlValue)])
-> IO [Maybe (ByteString, SqlValue)] -> IO [(ByteString, SqlValue)]
forall a b. (a -> b) -> a -> b
$ (Column -> IO (Maybe (ByteString, SqlValue)))
-> [Column] -> IO [Maybe (ByteString, SqlValue)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Column -> IO (Maybe (ByteString, SqlValue))
getIdentityValue [Int -> Column
Column Int
0 .. Column
maxColumn]

{- |
  Builds a 'SqlMarshaller' that maps a single field of a Haskell entity to
  a single column in the database. That value to store in the database will be
  retrieved from the entity using a provided accessor function. This function
  is intended to be used inside of a stanza of 'Applicative' syntax that will
  pass values read from the database to a constructor function to rebuild the
  entity containing the field, like so:

  @

  data Foo = Foo { bar :: Int32, baz :: Text }

  fooMarshaller :: SqlMarshaller Foo Foo
  fooMarshaller =
    Foo
      \<$\> marshallField bar (integerField "bar")
      \<*\> marshallField baz (unboundedTextField "baz")

  @

@since 1.0.0.0
-}
marshallField ::
  (writeEntity -> fieldValue) ->
  FieldDefinition nullability fieldValue ->
  SqlMarshaller writeEntity fieldValue
marshallField :: forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
marshallField writeEntity -> fieldValue
accessor FieldDefinition nullability fieldValue
fieldDef =
  (writeEntity -> fieldValue)
-> SqlMarshaller fieldValue fieldValue
-> SqlMarshaller writeEntity fieldValue
forall a a c. (a -> a) -> SqlMarshaller a c -> SqlMarshaller a c
MarshallNest writeEntity -> fieldValue
accessor (FieldDefinition nullability fieldValue
-> SqlMarshaller fieldValue fieldValue
forall a a. FieldDefinition a a -> SqlMarshaller a a
MarshallField FieldDefinition nullability fieldValue
fieldDef)

{- |
  Builds a 'SqlMarshaller' that will include a SQL expression in select
  statements to calculate a value using the columns of the table being selected
  from. The columns being used in the calculation do not themselves need
  to be selected, though they must be present in the table so they can
  be referenced.

  @
  data AgeCheck
    { atLeast21 :: Bool
    }

  fooMarshaller :: SqlMarshaller Void AgeCheck
  fooMarshaller =
    AgeCheck
      \<*\> Orville.marshallSyntheticField atLeast21Field

  atLeast21Field :: SyntheticField Bool
  atLeast21Field =
    SyntheticField
      { syntheticFieldExpression = RawSql.unsafeSqlExpression "age >= 21"
      , syntheticFieldAlias = Orville.stringToFieldName "over21"
      , syntheticFieldValueFromSqlValue = SqlValue.toBool
      }
  @

@since 1.0.0.0
-}
marshallSyntheticField ::
  SyntheticField fieldValue ->
  SqlMarshaller writeEntity fieldValue
marshallSyntheticField :: forall fieldValue writeEntity.
SyntheticField fieldValue -> SqlMarshaller writeEntity fieldValue
marshallSyntheticField =
  SyntheticField fieldValue -> SqlMarshaller writeEntity fieldValue
forall fieldValue writeEntity.
SyntheticField fieldValue -> SqlMarshaller writeEntity fieldValue
MarshallSyntheticField

{- |
  Nests a 'SqlMarshaller' inside another, using the given accessor to retrieve
  values to be marshalled. The resulting marshaller can then be used in the same
  way as 'marshallField' within the applicative syntax of a larger marshaller.

  For Example:

  @
  data Person =
    Person
      { personId :: PersonId
      , personName :: Name
      }

  data Name =
    Name
      { firstName :: Text
      , lastName :: Text
      }

  personMarshaller :: SqlMarshaller Person Person
  personMarshaller =
    Person
      \<$\> marshallField personId personIdField
      \<*\> marshallNested personName nameMarshaller

  nameMarshaller :: SqlMarshaller Name Name
  nameMarshaller =
    Name
      \<$\> marshallField firstName firstNameField
      \<*\> marshallField lastName lastNameField
  @

@since 1.0.0.0
-}
marshallNested ::
  (parentEntity -> nestedWriteEntity) ->
  SqlMarshaller nestedWriteEntity nestedReadEntity ->
  SqlMarshaller parentEntity nestedReadEntity
marshallNested :: forall a a c. (a -> a) -> SqlMarshaller a c -> SqlMarshaller a c
marshallNested =
  (parentEntity -> nestedWriteEntity)
-> SqlMarshaller nestedWriteEntity nestedReadEntity
-> SqlMarshaller parentEntity nestedReadEntity
forall a a c. (a -> a) -> SqlMarshaller a c -> SqlMarshaller a c
MarshallNest

{- |
  Lifts a 'SqlMarshaller' to have both read/write entities be 'Maybe',
  and applies a tag to avoid double mapping.

@since 1.0.0.0
-}
marshallMaybe :: SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
marshallMaybe :: forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
marshallMaybe =
  -- rewrite the mapper to handle null fields, then tag
  -- it as having been done so we don't double-map it
  -- in a future 'maybeMapper' call.
  SqlMarshaller (Maybe a) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
forall a b.
SqlMarshaller (Maybe a) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
MarshallMaybeTag (SqlMarshaller (Maybe a) (Maybe b)
 -> SqlMarshaller (Maybe a) (Maybe b))
-> (SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b))
-> SqlMarshaller a b
-> SqlMarshaller (Maybe a) (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
go
 where
  go :: SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
  go :: forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
go SqlMarshaller a b
marshaller =
    case SqlMarshaller a b
marshaller of
      MarshallPure b
a ->
        Maybe b -> SqlMarshaller (Maybe a) (Maybe b)
forall b a. b -> SqlMarshaller a b
MarshallPure (Maybe b -> SqlMarshaller (Maybe a) (Maybe b))
-> Maybe b -> SqlMarshaller (Maybe a) (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
      MarshallApply SqlMarshaller a (b -> b)
func SqlMarshaller a b
a ->
        SqlMarshaller (Maybe a) (Maybe b -> Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
forall a a c.
SqlMarshaller a (a -> c) -> SqlMarshaller a a -> SqlMarshaller a c
MarshallApply ((Maybe (b -> b) -> Maybe b -> Maybe b)
-> SqlMarshaller (Maybe a) (Maybe (b -> b))
-> SqlMarshaller (Maybe a) (Maybe b -> Maybe b)
forall a b.
(a -> b) -> SqlMarshaller (Maybe a) a -> SqlMarshaller (Maybe a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (b -> b) -> Maybe b -> Maybe b
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (SqlMarshaller (Maybe a) (Maybe (b -> b))
 -> SqlMarshaller (Maybe a) (Maybe b -> Maybe b))
-> SqlMarshaller (Maybe a) (Maybe (b -> b))
-> SqlMarshaller (Maybe a) (Maybe b -> Maybe b)
forall a b. (a -> b) -> a -> b
$ SqlMarshaller a (b -> b)
-> SqlMarshaller (Maybe a) (Maybe (b -> b))
forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
go SqlMarshaller a (b -> b)
func) (SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
go SqlMarshaller a b
a)
      MarshallNest a -> b
f SqlMarshaller b b
a ->
        (Maybe a -> Maybe b)
-> SqlMarshaller (Maybe b) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
forall a a c. (a -> a) -> SqlMarshaller a c -> SqlMarshaller a c
MarshallNest ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (SqlMarshaller b b -> SqlMarshaller (Maybe b) (Maybe b)
forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
go SqlMarshaller b b
a)
      (MarshallMaybeTag SqlMarshaller (Maybe a) (Maybe b)
_) ->
        b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b)
-> SqlMarshaller (Maybe a) b -> SqlMarshaller (Maybe a) (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe a -> Maybe a)
-> SqlMarshaller (Maybe a) b -> SqlMarshaller (Maybe a) b
forall a a c. (a -> a) -> SqlMarshaller a c -> SqlMarshaller a c
MarshallNest Maybe a -> Maybe a
Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join SqlMarshaller a b
SqlMarshaller (Maybe a) b
marshaller
      MarshallField FieldDefinition nullability a
field ->
        case FieldDefinition nullability a -> FieldNullability a
forall nullability a.
FieldDefinition nullability a -> FieldNullability a
fieldNullability FieldDefinition nullability a
field of
          NotNullField FieldDefinition NotNull a
f -> FieldDefinition Nullable (Maybe a)
-> SqlMarshaller (Maybe a) (Maybe a)
forall a a. FieldDefinition a a -> SqlMarshaller a a
MarshallField (FieldDefinition NotNull a -> FieldDefinition Nullable (Maybe a)
forall a.
FieldDefinition NotNull a -> FieldDefinition Nullable (Maybe a)
nullableField FieldDefinition NotNull a
f)
          NullableField FieldDefinition Nullable a
f -> FieldDefinition Nullable (Maybe a)
-> SqlMarshaller (Maybe a) (Maybe a)
forall a a. FieldDefinition a a -> SqlMarshaller a a
MarshallField (FieldDefinition Nullable a -> FieldDefinition Nullable (Maybe a)
forall a.
FieldDefinition Nullable a -> FieldDefinition Nullable (Maybe a)
asymmetricNullableField FieldDefinition Nullable a
f)
      MarshallSyntheticField SyntheticField b
synthField ->
        SyntheticField (Maybe b) -> SqlMarshaller (Maybe a) (Maybe b)
forall fieldValue writeEntity.
SyntheticField fieldValue -> SqlMarshaller writeEntity fieldValue
MarshallSyntheticField (SyntheticField b -> SyntheticField (Maybe b)
forall a. SyntheticField a -> SyntheticField (Maybe a)
nullableSyntheticField SyntheticField b
synthField)
      MarshallPartial SqlMarshaller a (Either String b)
m ->
        SqlMarshaller (Maybe a) (Either String (Maybe b))
-> SqlMarshaller (Maybe a) (Maybe b)
forall a b. SqlMarshaller a (Either String b) -> SqlMarshaller a b
MarshallPartial ((Maybe (Either String b) -> Either String (Maybe b))
-> SqlMarshaller (Maybe a) (Maybe (Either String b))
-> SqlMarshaller (Maybe a) (Either String (Maybe b))
forall a b.
(a -> b) -> SqlMarshaller (Maybe a) a -> SqlMarshaller (Maybe a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Either String b) -> Either String (Maybe b)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence (SqlMarshaller (Maybe a) (Maybe (Either String b))
 -> SqlMarshaller (Maybe a) (Either String (Maybe b)))
-> SqlMarshaller (Maybe a) (Maybe (Either String b))
-> SqlMarshaller (Maybe a) (Either String (Maybe b))
forall a b. (a -> b) -> a -> b
$ SqlMarshaller a (Either String b)
-> SqlMarshaller (Maybe a) (Maybe (Either String b))
forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
go SqlMarshaller a (Either String b)
m)
      MarshallReadOnly SqlMarshaller a b
m ->
        SqlMarshaller (Maybe a) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
forall a b c. SqlMarshaller a b -> SqlMarshaller c b
MarshallReadOnly (SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
go SqlMarshaller a b
m)

{- |
  Builds a 'SqlMarshaller' that will raise a decoding error when the value
  produced is a 'Left'.

@since 1.0.0.0
-}
marshallPartial :: SqlMarshaller a (Either String b) -> SqlMarshaller a b
marshallPartial :: forall a b. SqlMarshaller a (Either String b) -> SqlMarshaller a b
marshallPartial = SqlMarshaller a (Either String b) -> SqlMarshaller a b
forall a b. SqlMarshaller a (Either String b) -> SqlMarshaller a b
MarshallPartial

{- |
  Adds a prefix, followed by an underscore, to the names of all of the fields
  and synthetic fields in a 'SqlMarshaller'.

@since 1.0.0.0
-}
prefixMarshaller ::
  String ->
  SqlMarshaller readEntity writeEntity ->
  SqlMarshaller readEntity writeEntity
prefixMarshaller :: forall readEntity writeEntity.
String
-> SqlMarshaller readEntity writeEntity
-> SqlMarshaller readEntity writeEntity
prefixMarshaller String
prefix = SqlMarshaller readEntity writeEntity
-> SqlMarshaller readEntity writeEntity
forall a b. SqlMarshaller a b -> SqlMarshaller a b
go
 where
  go :: SqlMarshaller a b -> SqlMarshaller a b
  go :: forall a b. SqlMarshaller a b -> SqlMarshaller a b
go SqlMarshaller a b
marshaller = case SqlMarshaller a b
marshaller of
    MarshallPure b
b -> b -> SqlMarshaller a b
forall b a. b -> SqlMarshaller a b
MarshallPure b
b
    MarshallApply SqlMarshaller a (b -> b)
m1 SqlMarshaller a b
m2 ->
      SqlMarshaller a (b -> b) -> SqlMarshaller a b -> SqlMarshaller a b
forall a a c.
SqlMarshaller a (a -> c) -> SqlMarshaller a a -> SqlMarshaller a c
MarshallApply (SqlMarshaller a (b -> b) -> SqlMarshaller a (b -> b)
forall a b. SqlMarshaller a b -> SqlMarshaller a b
go SqlMarshaller a (b -> b)
m1) (SqlMarshaller a b -> SqlMarshaller a b)
-> SqlMarshaller a b -> SqlMarshaller a b
forall a b. (a -> b) -> a -> b
$ SqlMarshaller a b -> SqlMarshaller a b
forall a b. SqlMarshaller a b -> SqlMarshaller a b
go SqlMarshaller a b
m2
    MarshallNest a -> b
f SqlMarshaller b b
m ->
      (a -> b) -> SqlMarshaller b b -> SqlMarshaller a b
forall a a c. (a -> a) -> SqlMarshaller a c -> SqlMarshaller a c
MarshallNest a -> b
f (SqlMarshaller b b -> SqlMarshaller a b)
-> SqlMarshaller b b -> SqlMarshaller a b
forall a b. (a -> b) -> a -> b
$ SqlMarshaller b b -> SqlMarshaller b b
forall a b. SqlMarshaller a b -> SqlMarshaller a b
go SqlMarshaller b b
m
    MarshallField FieldDefinition nullability a
fieldDefinition ->
      FieldDefinition nullability a -> SqlMarshaller a a
forall a a. FieldDefinition a a -> SqlMarshaller a a
MarshallField (FieldDefinition nullability a -> SqlMarshaller a a)
-> FieldDefinition nullability a -> SqlMarshaller a a
forall a b. (a -> b) -> a -> b
$ String
-> FieldDefinition nullability a -> FieldDefinition nullability a
forall nullability a.
String
-> FieldDefinition nullability a -> FieldDefinition nullability a
prefixField String
prefix FieldDefinition nullability a
fieldDefinition
    MarshallSyntheticField SyntheticField b
syntheticField ->
      SyntheticField b -> SqlMarshaller a b
forall fieldValue writeEntity.
SyntheticField fieldValue -> SqlMarshaller writeEntity fieldValue
MarshallSyntheticField (SyntheticField b -> SqlMarshaller a b)
-> SyntheticField b -> SqlMarshaller a b
forall a b. (a -> b) -> a -> b
$ String -> SyntheticField b -> SyntheticField b
forall a. String -> SyntheticField a -> SyntheticField a
prefixSyntheticField String
prefix SyntheticField b
syntheticField
    MarshallMaybeTag SqlMarshaller (Maybe a) (Maybe b)
m -> SqlMarshaller (Maybe a) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
forall a b.
SqlMarshaller (Maybe a) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
MarshallMaybeTag (SqlMarshaller (Maybe a) (Maybe b)
 -> SqlMarshaller (Maybe a) (Maybe b))
-> SqlMarshaller (Maybe a) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
forall a b. (a -> b) -> a -> b
$ SqlMarshaller (Maybe a) (Maybe b)
-> SqlMarshaller (Maybe a) (Maybe b)
forall a b. SqlMarshaller a b -> SqlMarshaller a b
go SqlMarshaller (Maybe a) (Maybe b)
m
    MarshallPartial SqlMarshaller a (Either String b)
m -> SqlMarshaller a (Either String b) -> SqlMarshaller a b
forall a b. SqlMarshaller a (Either String b) -> SqlMarshaller a b
MarshallPartial (SqlMarshaller a (Either String b) -> SqlMarshaller a b)
-> SqlMarshaller a (Either String b) -> SqlMarshaller a b
forall a b. (a -> b) -> a -> b
$ SqlMarshaller a (Either String b)
-> SqlMarshaller a (Either String b)
forall a b. SqlMarshaller a b -> SqlMarshaller a b
go SqlMarshaller a (Either String b)
m
    MarshallReadOnly SqlMarshaller a b
m -> SqlMarshaller a b -> SqlMarshaller a b
forall a b c. SqlMarshaller a b -> SqlMarshaller c b
MarshallReadOnly (SqlMarshaller a b -> SqlMarshaller a b)
-> SqlMarshaller a b -> SqlMarshaller a b
forall a b. (a -> b) -> a -> b
$ SqlMarshaller a b -> SqlMarshaller a b
forall a b. SqlMarshaller a b -> SqlMarshaller a b
go SqlMarshaller a b
m

{- |
  Marks a 'SqlMarshaller' as read-only so that it will not attempt to
  read any values from the @writeEntity@. You should use this if you have
  a group of fields which are populated by database rather than the application.

@since 1.0.0.0
-}
marshallReadOnly :: SqlMarshaller a b -> SqlMarshaller c b
marshallReadOnly :: forall a b c. SqlMarshaller a b -> SqlMarshaller c b
marshallReadOnly = SqlMarshaller a b -> SqlMarshaller c b
forall a b c. SqlMarshaller a b -> SqlMarshaller c b
MarshallReadOnly

{- |
  A version of 'marshallField' that uses 'marshallReadOnly' to make a single
  read-only field. You will usually use this in conjunction with a
  'FieldDefinition' like @serialField@ where the value is populated by the
  database.

@since 1.0.0.0
-}
marshallReadOnlyField ::
  FieldDefinition nullability fieldValue ->
  SqlMarshaller writeEntity fieldValue
marshallReadOnlyField :: forall nullability fieldValue writeEntity.
FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
marshallReadOnlyField = SqlMarshaller fieldValue fieldValue
-> SqlMarshaller writeEntity fieldValue
forall a b c. SqlMarshaller a b -> SqlMarshaller c b
MarshallReadOnly (SqlMarshaller fieldValue fieldValue
 -> SqlMarshaller writeEntity fieldValue)
-> (FieldDefinition nullability fieldValue
    -> SqlMarshaller fieldValue fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition nullability fieldValue
-> SqlMarshaller fieldValue fieldValue
forall a a. FieldDefinition a a -> SqlMarshaller a a
MarshallField