{-# 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 :: SContext context
-> Either (NonNullifiability context) (Nullifiability context)
nullifiableOrNot = \case
SContext context
SAggregate -> Nullifiability Aggregate
-> Either (NonNullifiability context) (Nullifiability Aggregate)
forall a b. b -> Either a b
Right Nullifiability Aggregate
NAggregate
SContext context
SExpr -> Nullifiability Expr
-> Either (NonNullifiability context) (Nullifiability Expr)
forall a b. b -> Either a b
Right Nullifiability Expr
NExpr
SContext context
SField -> NonNullifiability (Field table)
-> Either
(NonNullifiability (Field table)) (Nullifiability context)
forall a b. a -> Either a b
Left NonNullifiability (Field table)
forall table. NonNullifiability (Field table)
NField
SContext context
SName -> Nullifiability Name
-> Either (NonNullifiability context) (Nullifiability Name)
forall a b. b -> Either a b
Right Nullifiability Name
NName
SContext context
SResult -> NonNullifiability Result
-> Either (NonNullifiability Result) (Nullifiability context)
forall a b. a -> Either a b
Left NonNullifiability Result
NResult
absurd :: Nullifiability context -> NonNullifiability context -> a
absurd :: 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 :: 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 -> (Expr tag -> Expr (Maybe a) -> Expr (Maybe a))
-> Aggregate tag -> Aggregate (Maybe a) -> Aggregate (Maybe a)
forall a b c.
(Expr a -> Expr b -> Expr c)
-> Aggregate a -> Aggregate b -> Aggregate c
zipOutputs (Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
forall a. Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard (Expr Bool -> Expr (Maybe a) -> Expr (Maybe a))
-> (Expr tag -> Expr Bool)
-> Expr tag
-> Expr (Maybe a)
-> Expr (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr tag -> Expr Bool
isNonNull) context tag
Aggregate tag
tag
SContext context
SExpr -> \context tag
tag tag -> Bool
_ Expr tag -> Expr Bool
isNonNull -> Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
forall a. Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard (Expr tag -> Expr Bool
isNonNull context tag
Expr tag
tag)
SContext context
SField -> \context tag
_ tag -> Bool
_ Expr tag -> Expr Bool
_ -> context (Maybe a) -> context (Maybe a)
forall a. a -> a
id
SContext context
SName -> \context tag
_ tag -> Bool
_ Expr tag -> Expr Bool
_ -> context (Maybe a) -> context (Maybe a)
forall a. a -> a
id
SContext context
SResult -> \(Identity tag) tag -> Bool
isNonNull Expr tag -> Expr Bool
_ (Identity a) ->
Maybe a -> Identity (Maybe a)
forall a. a -> Identity a
Identity (Maybe a -> Maybe a -> Bool -> Maybe a
forall a. a -> a -> Bool -> a
bool Maybe a
forall a. Maybe a
Nothing Maybe a
a (tag -> Bool
isNonNull tag
tag))
nullifier :: ()
=> Nullifiability context
-> Spec a
-> context a
-> context (Nullify a)
nullifier :: 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 a) ->
Aggregator () (Expr (Nullify a)) -> Aggregate (Nullify a)
forall a. Aggregator () (Expr a) -> Aggregate a
Aggregate (Aggregator () (Expr (Nullify a)) -> Aggregate (Nullify a))
-> Aggregator () (Expr (Nullify a)) -> Aggregate (Nullify a)
forall a b. (a -> b) -> a -> b
$ Nullity a -> Expr a -> Expr (Nullify a)
forall a. Nullity a -> Expr a -> Expr (Nullify a)
snullify Nullity a
nullity (Expr a -> Expr (Nullify a))
-> Aggregator () (Expr a) -> Aggregator () (Expr (Nullify a))
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 -> Nullity a -> Expr a -> Expr (Nullify a)
forall a. Nullity a -> Expr a -> Expr (Nullify a)
snullify Nullity a
nullity context a
Expr a
a
Nullifiability context
NName -> \Spec a
_ (Name a) -> String -> Name (Nullify a)
forall a. String -> Name a
Name String
a
unnullifier :: ()
=> Nullifiability context
-> Spec a
-> context (Nullify a)
-> context a
unnullifier :: 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 a) ->
Aggregator () (Expr a) -> Aggregate a
forall a. Aggregator () (Expr a) -> Aggregate a
Aggregate (Aggregator () (Expr a) -> Aggregate a)
-> Aggregator () (Expr a) -> Aggregate a
forall a b. (a -> b) -> a -> b
$ Nullity a -> Expr (Nullify a) -> Expr a
forall a. Nullity a -> Expr (Nullify a) -> Expr a
sunnullify Nullity a
nullity (Expr (Nullify a) -> Expr a)
-> Aggregator () (Expr (Nullify a)) -> Aggregator () (Expr a)
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 -> Nullity a -> Expr (Nullify a) -> Expr a
forall a. Nullity a -> Expr (Nullify a) -> Expr a
sunnullify Nullity a
nullity context (Nullify a)
Expr (Nullify a)
a
Nullifiability context
NName -> \Spec a
_ (Name a) -> String -> Name a
forall a. String -> Name a
Name String
a
sguard :: Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard :: Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard Expr Bool
condition Expr (Maybe a)
a = Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool -> Expr (Maybe a)
forall a. Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr Expr (Maybe a)
forall a. Expr a
null Expr (Maybe a)
a Expr Bool
condition
where
null :: Expr a
null = PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a) -> PrimExpr -> Expr a
forall a b. (a -> b) -> a -> b
$ Literal -> PrimExpr
Opaleye.ConstExpr Literal
Opaleye.NullLit
snullify :: Nullity a -> Expr a -> Expr (Nullify a)
snullify :: Nullity a -> Expr a -> Expr (Nullify a)
snullify Nullity a
nullity Expr a
a = case Nullity a
nullity of
Nullity a
Null -> Expr a
Expr (Nullify a)
a
Nullity a
NotNull -> Expr a -> Expr (Maybe a)
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify Expr a
a
sunnullify :: Nullity a -> Expr (Nullify a) -> Expr a
sunnullify :: Nullity a -> Expr (Nullify a) -> Expr a
sunnullify Nullity a
nullity Expr (Nullify a)
a = case Nullity a
nullity of
Nullity a
Null -> Expr a
Expr (Nullify a)
a
Nullity a
NotNull -> Expr (Maybe a) -> Expr a
forall a. Expr (Maybe a) -> Expr a
unsafeUnnullify Expr (Maybe a)
Expr (Nullify a)
a