{-# language DataKinds #-}
{-# language EmptyCase #-}
{-# language FlexibleContexts #-}
{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}
{-# language StandaloneKindSignatures #-}
module Rel8.Schema.Context.Nullify
( Nullifiability(..), NonNullifiability(..), nullifiableOrNot, absurd
, Nullifiable, nullifiability
, guarder, nullifier, unnullifier
, sguard, snullify
)
where
import Data.Bool ( bool )
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Constraint, Type )
import Prelude hiding ( null )
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import Rel8.Aggregate ( Aggregate(..), zipOutputs )
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( boolExpr )
import Rel8.Expr.Null ( nullify, unsafeUnnullify )
import Rel8.Expr.Opaleye ( fromPrimExpr )
import Rel8.Kind.Context ( SContext(..) )
import Rel8.Schema.Field ( Field )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Name ( Name( Name ) )
import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )
import Rel8.Schema.Result ( Result )
import Rel8.Schema.Spec ( Spec(..) )
type Nullifiability :: K.Context -> Type
data Nullifiability context where
NAggregate :: Nullifiability Aggregate
NExpr :: Nullifiability Expr
NName :: Nullifiability Name
type Nullifiable :: K.Context -> Constraint
class Nullifiable context where
nullifiability :: Nullifiability context
instance Nullifiable Aggregate where
nullifiability :: Nullifiability Aggregate
nullifiability = Nullifiability Aggregate
NAggregate
instance Nullifiable Expr where
nullifiability :: Nullifiability Expr
nullifiability = Nullifiability Expr
NExpr
instance Nullifiable Name where
nullifiability :: Nullifiability Name
nullifiability = Nullifiability Name
NName
type NonNullifiability :: K.Context -> Type
data NonNullifiability context where
NField :: NonNullifiability (Field table)
NResult :: NonNullifiability Result
nullifiableOrNot :: ()
=> SContext context
-> Either (NonNullifiability context) (Nullifiability context)
nullifiableOrNot :: forall (context :: Context).
SContext context
-> Either (NonNullifiability context) (Nullifiability context)
nullifiableOrNot = \case
SContext context
SAggregate -> forall a b. b -> Either a b
Right Nullifiability Aggregate
NAggregate
SContext context
SExpr -> forall a b. b -> Either a b
Right Nullifiability Expr
NExpr
SContext context
SField -> forall a b. a -> Either a b
Left forall table. NonNullifiability (Field table)
NField
SContext context
SName -> forall a b. b -> Either a b
Right Nullifiability Name
NName
SContext context
SResult -> forall a b. a -> Either a b
Left NonNullifiability Identity
NResult
absurd :: Nullifiability context -> NonNullifiability context -> a
absurd :: forall (context :: Context) a.
Nullifiability context -> NonNullifiability context -> a
absurd = \case
Nullifiability context
NAggregate -> NonNullifiability context -> a
\case
Nullifiability context
NExpr -> NonNullifiability context -> a
\case
Nullifiability context
NName -> NonNullifiability context -> a
\case
guarder :: ()
=> SContext context
-> context tag
-> (tag -> Bool)
-> (Expr tag -> Expr Bool)
-> context (Maybe a)
-> context (Maybe a)
guarder :: forall (context :: Context) tag a.
SContext context
-> context tag
-> (tag -> Bool)
-> (Expr tag -> Expr Bool)
-> context (Maybe a)
-> context (Maybe a)
guarder = \case
SContext context
SAggregate -> \context tag
tag tag -> Bool
_ Expr tag -> Expr Bool
isNonNull -> forall a b c.
(Expr a -> Expr b -> Expr c)
-> Aggregate a -> Aggregate b -> Aggregate c
zipOutputs (forall a. Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr tag -> Expr Bool
isNonNull) context tag
tag
SContext context
SExpr -> \context tag
tag tag -> Bool
_ Expr tag -> Expr Bool
isNonNull -> forall a. Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard (Expr tag -> Expr Bool
isNonNull context tag
tag)
SContext context
SField -> \context tag
_ tag -> Bool
_ Expr tag -> Expr Bool
_ -> forall a. a -> a
id
SContext context
SName -> \context tag
_ tag -> Bool
_ Expr tag -> Expr Bool
_ -> forall a. a -> a
id
SContext context
SResult -> \(Identity tag
tag) tag -> Bool
isNonNull Expr tag -> Expr Bool
_ (Identity Maybe a
a) ->
forall a. a -> Identity a
Identity (forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing Maybe a
a (tag -> Bool
isNonNull tag
tag))
nullifier :: ()
=> Nullifiability context
-> Spec a
-> context a
-> context (Nullify a)
nullifier :: forall (context :: Context) a.
Nullifiability context
-> Spec a -> context a -> context (Nullify a)
nullifier = \case
Nullifiability context
NAggregate -> \Spec {Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity :: Nullity a
nullity} (Aggregate Aggregator () (Expr a)
a) ->
forall a. Aggregator () (Expr a) -> Aggregate a
Aggregate forall a b. (a -> b) -> a -> b
$ forall a. Nullity a -> Expr a -> Expr (Nullify a)
snullify Nullity a
nullity forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> Aggregator () (Expr a)
a
Nullifiability context
NExpr -> \Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} context a
a -> forall a. Nullity a -> Expr a -> Expr (Nullify a)
snullify Nullity a
nullity context a
a
Nullifiability context
NName -> \Spec a
_ (Name String
a) -> forall a. String -> Name a
Name String
a
unnullifier :: ()
=> Nullifiability context
-> Spec a
-> context (Nullify a)
-> context a
unnullifier :: forall (context :: Context) a.
Nullifiability context
-> Spec a -> context (Nullify a) -> context a
unnullifier = \case
Nullifiability context
NAggregate -> \Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} (Aggregate Aggregator () (Expr (Nullify a))
a) ->
forall a. Aggregator () (Expr a) -> Aggregate a
Aggregate forall a b. (a -> b) -> a -> b
$ forall a. Nullity a -> Expr (Nullify a) -> Expr a
sunnullify Nullity a
nullity forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> Aggregator () (Expr (Nullify a))
a
Nullifiability context
NExpr -> \Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} context (Nullify a)
a -> forall a. Nullity a -> Expr (Nullify a) -> Expr a
sunnullify Nullity a
nullity context (Nullify a)
a
Nullifiability context
NName -> \Spec a
_ (Name String
a) -> forall a. String -> Name a
Name String
a
sguard :: Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard :: forall a. Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard Expr Bool
condition Expr (Maybe a)
a = forall a. Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr forall {a}. Expr a
null Expr (Maybe a)
a Expr Bool
condition
where
null :: Expr a
null = forall a. PrimExpr -> Expr a
fromPrimExpr forall a b. (a -> b) -> a -> b
$ Literal -> PrimExpr
Opaleye.ConstExpr Literal
Opaleye.NullLit
snullify :: Nullity a -> Expr a -> Expr (Nullify a)
snullify :: forall a. Nullity a -> Expr a -> Expr (Nullify a)
snullify Nullity a
nullity Expr a
a = case Nullity a
nullity of
Nullity a
Null -> Expr a
a
Nullity a
NotNull -> forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify Expr a
a
sunnullify :: Nullity a -> Expr (Nullify a) -> Expr a
sunnullify :: forall a. Nullity a -> Expr (Nullify a) -> Expr a
sunnullify Nullity a
nullity Expr (Nullify a)
a = case Nullity a
nullity of
Nullity a
Null -> Expr (Nullify a)
a
Nullity a
NotNull -> forall a. Expr (Maybe a) -> Expr a
unsafeUnnullify Expr (Nullify a)
a