{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
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
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
}
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
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 []
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)
data SqlMarshaller a b where
MarshallPure :: b -> SqlMarshaller a b
MarshallApply :: SqlMarshaller a (b -> c) -> SqlMarshaller a b -> SqlMarshaller a c
MarshallNest :: (a -> b) -> SqlMarshaller b c -> SqlMarshaller a c
MarshallField :: FieldDefinition nullability a -> SqlMarshaller a a
MarshallSyntheticField :: SyntheticField a -> SqlMarshaller b a
MarshallMaybeTag :: SqlMarshaller (Maybe a) (Maybe b) -> SqlMarshaller (Maybe a) (Maybe b)
MarshallPartial :: SqlMarshaller a (Either String b) -> SqlMarshaller a b
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
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
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
data MarshallerField writeEntity where
Natural :: FieldDefinition nullability a -> Maybe (writeEntity -> a) -> MarshallerField writeEntity
Synthetic :: SyntheticField a -> MarshallerField writeEntity
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
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)
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
data ReadOnlyColumnOption
= IncludeReadOnlyColumns
| ExcludeReadOnlyColumns
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)
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
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
marshallResultFromSqlUsingRowIdExtractor ::
ExecutionResult result =>
ErrorDetailLevel ->
RowIdentityExtractor ->
SqlMarshaller writeEntity readEntity ->
result ->
IO (Either MarshallError.MarshallError [readEntity])
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))
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
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
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)
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
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)
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
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 =
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
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
}
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)
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)
newtype
= (Row -> IO [(B8.ByteString, SqlValue.SqlValue)])
mkRowIdentityExtractor ::
ExecutionResult result =>
[FieldName] ->
result ->
RowIdentityExtractor
[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]
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)
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
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
marshallMaybe :: SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
marshallMaybe :: forall a b. SqlMarshaller a b -> SqlMarshaller (Maybe a) (Maybe b)
marshallMaybe =
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)
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
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
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
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