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