{-# language FlexibleContexts #-}
{-# language NamedFieldPuns #-}
{-# language TypeFamilies #-}

module Rel8.Expr.Serialize
  ( litExpr
  , slitExpr
  , sparseValue
  )
where

-- base
import Prelude

-- hasql
import qualified Hasql.Decoders as Hasql

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

-- rel8
import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )
import Rel8.Expr.Opaleye ( scastExpr )
import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ), Sql, nullable )
import Rel8.Type ( DBType, typeInformation )
import Rel8.Type.Information ( TypeInformation(..) )


-- | Produce an expression from a literal.
--
-- Note that you can usually use 'Rel8.lit', but @litExpr@ can solve problems
-- of inference in polymorphic code.
litExpr :: Sql DBType a => a -> Expr a
litExpr :: a -> Expr a
litExpr = Nullity a -> TypeInformation (Unnullify a) -> a -> Expr a
forall a. Nullity a -> TypeInformation (Unnullify a) -> a -> Expr a
slitExpr Nullity a
forall a. Nullable a => Nullity a
nullable TypeInformation (Unnullify a)
forall a. DBType a => TypeInformation a
typeInformation


slitExpr :: Nullity a -> TypeInformation (Unnullify a) -> a -> Expr a
slitExpr :: Nullity a -> TypeInformation (Unnullify a) -> a -> Expr a
slitExpr Nullity a
nullity info :: TypeInformation (Unnullify a)
info@TypeInformation {Unnullify a -> PrimExpr
encode :: forall a. TypeInformation a -> a -> PrimExpr
encode :: Unnullify a -> PrimExpr
encode} =
  TypeInformation (Unnullify a) -> Expr a -> Expr a
forall a. TypeInformation (Unnullify a) -> Expr a -> Expr a
scastExpr TypeInformation (Unnullify a)
info (Expr a -> Expr a) -> (a -> Expr a) -> a -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
Expr (PrimExpr -> Expr a) -> (a -> PrimExpr) -> a -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PrimExpr
encoder
  where
    encoder :: a -> PrimExpr
encoder = case Nullity a
nullity of
      Nullity a
Null -> PrimExpr -> (a -> PrimExpr) -> Maybe a -> PrimExpr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Literal -> PrimExpr
Opaleye.ConstExpr Literal
Opaleye.NullLit) a -> PrimExpr
Unnullify a -> PrimExpr
encode
      Nullity a
NotNull -> a -> PrimExpr
Unnullify a -> PrimExpr
encode


sparseValue :: Nullity a -> TypeInformation (Unnullify a) -> Hasql.Row a
sparseValue :: Nullity a -> TypeInformation (Unnullify a) -> Row a
sparseValue Nullity a
nullity TypeInformation {Value (Unnullify a)
decode :: forall a. TypeInformation a -> Value a
decode :: Value (Unnullify a)
decode} = case Nullity a
nullity of
  Nullity a
Null -> NullableOrNot Value (Maybe a) -> Row (Maybe a)
forall a. NullableOrNot Value a -> Row a
Hasql.column (NullableOrNot Value (Maybe a) -> Row (Maybe a))
-> NullableOrNot Value (Maybe a) -> Row (Maybe a)
forall a b. (a -> b) -> a -> b
$ Value a -> NullableOrNot Value (Maybe a)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
Hasql.nullable Value a
Value (Unnullify a)
decode
  Nullity a
NotNull -> NullableOrNot Value a -> Row a
forall a. NullableOrNot Value a -> Row a
Hasql.column (NullableOrNot Value a -> Row a) -> NullableOrNot Value a -> Row a
forall a b. (a -> b) -> a -> b
$ Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
Hasql.nonNullable Value a
Value (Unnullify a)
decode