{-# LANGUAGE OverloadedStrings #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Marshall.SyntheticField
  ( SyntheticField
  , syntheticFieldExpression
  , syntheticFieldAlias
  , syntheticFieldValueFromSqlValue
  , syntheticField
  , nullableSyntheticField
  , prefixSyntheticField
  )
where

import qualified Data.ByteString.Char8 as B8
import qualified Orville.PostgreSQL.Expr as Expr
import Orville.PostgreSQL.Marshall.FieldDefinition (FieldName, byteStringToFieldName, fieldNameToByteString, stringToFieldName)
import qualified Orville.PostgreSQL.Raw.SqlValue as SqlValue

{- |
  A 'SyntheticField' can be used to evaluate a SQL expression based on the
  columns of a table when records are selected from the database. Synthetic
  fields are inherently read-only.

@since 1.0.0.0
-}
data SyntheticField a = SyntheticField
  { forall a. SyntheticField a -> ValueExpression
_syntheticFieldExpression :: Expr.ValueExpression
  , forall a. SyntheticField a -> FieldName
_syntheticFieldAlias :: FieldName
  , forall a. SyntheticField a -> SqlValue -> Either String a
_syntheticFieldValueFromSqlValue :: SqlValue.SqlValue -> Either String a
  }

{- |
  Returns the SQL expression that should be used in select statements to
  calculate the synthetic field.

@since 1.0.0.0
-}
syntheticFieldExpression :: SyntheticField a -> Expr.ValueExpression
syntheticFieldExpression :: forall a. SyntheticField a -> ValueExpression
syntheticFieldExpression =
  SyntheticField a -> ValueExpression
forall a. SyntheticField a -> ValueExpression
_syntheticFieldExpression

{- |
  Returns the alias that should be used in select statements to name the
  synthetic field.

@since 1.0.0.0
-}
syntheticFieldAlias :: SyntheticField a -> FieldName
syntheticFieldAlias :: forall a. SyntheticField a -> FieldName
syntheticFieldAlias =
  SyntheticField a -> FieldName
forall a. SyntheticField a -> FieldName
_syntheticFieldAlias

{- |
  Decodes a calculated value selected from the database to its expected
  Haskell type. Returns a 'Left' with an error message if the decoding fails.

@since 1.0.0.0
-}
syntheticFieldValueFromSqlValue :: SyntheticField a -> SqlValue.SqlValue -> Either String a
syntheticFieldValueFromSqlValue :: forall a. SyntheticField a -> SqlValue -> Either String a
syntheticFieldValueFromSqlValue =
  SyntheticField a -> SqlValue -> Either String a
forall a. SyntheticField a -> SqlValue -> Either String a
_syntheticFieldValueFromSqlValue

{- |
  Constructs a 'SyntheticField' that will select a SQL expression using
  the given alias.

@since 1.0.0.0
-}
syntheticField ::
  -- | The SQL expression to be selected.
  Expr.ValueExpression ->
  -- | The alias to be used to name the calculation in SQL expressions.
  String ->
  -- | A function to decode the expression result from a 'SqlValue.SqlValue'.
  (SqlValue.SqlValue -> Either String a) ->
  SyntheticField a
syntheticField :: forall a.
ValueExpression
-> String -> (SqlValue -> Either String a) -> SyntheticField a
syntheticField ValueExpression
expression String
alias SqlValue -> Either String a
fromSqlValue =
  SyntheticField
    { _syntheticFieldExpression :: ValueExpression
_syntheticFieldExpression = ValueExpression
expression
    , _syntheticFieldAlias :: FieldName
_syntheticFieldAlias = String -> FieldName
stringToFieldName String
alias
    , _syntheticFieldValueFromSqlValue :: SqlValue -> Either String a
_syntheticFieldValueFromSqlValue = SqlValue -> Either String a
fromSqlValue
    }

{- |
  Modifies a 'SyntheticField' to allow it to decode @NULL@ values.

@since 1.0.0.0
-}
nullableSyntheticField :: SyntheticField a -> SyntheticField (Maybe a)
nullableSyntheticField :: forall a. SyntheticField a -> SyntheticField (Maybe a)
nullableSyntheticField SyntheticField a
synthField =
  SyntheticField a
synthField
    { _syntheticFieldValueFromSqlValue :: SqlValue -> Either String (Maybe a)
_syntheticFieldValueFromSqlValue = \SqlValue
sqlValue ->
        if SqlValue -> Bool
SqlValue.isSqlNull SqlValue
sqlValue
          then Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
          else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SyntheticField a -> SqlValue -> Either String a
forall a. SyntheticField a -> SqlValue -> Either String a
syntheticFieldValueFromSqlValue SyntheticField a
synthField SqlValue
sqlValue
    }

{- |
  Adds a prefix, followed by an underscore, to the alias used to name the
  synthetic field.

@since 1.0.0.0
-}
prefixSyntheticField ::
  String ->
  SyntheticField a ->
  SyntheticField a
prefixSyntheticField :: forall a. String -> SyntheticField a -> SyntheticField a
prefixSyntheticField String
prefix SyntheticField a
synthField =
  SyntheticField a
synthField
    { _syntheticFieldAlias :: FieldName
_syntheticFieldAlias = ByteString -> FieldName
byteStringToFieldName (String -> ByteString
B8.pack String
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"_" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> FieldName -> ByteString
fieldNameToByteString (SyntheticField a -> FieldName
forall a. SyntheticField a -> FieldName
syntheticFieldAlias SyntheticField a
synthField))
    }