{-# 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

-- base
import Data.Bool ( bool )
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Constraint, Type )
import Prelude hiding ( null )

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

-- rel8
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