{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Table.Nullify
  ( Nullify
  , aggregateNullify
  , guard
  , isNull
  )
where

-- base
import Control.Applicative ( liftA2 )
import Data.Functor.Const ( Const( Const ), getConst )
import Data.Functor.Identity ( runIdentity )
import Data.Kind ( Type )
import Prelude

-- comonad
import Control.Comonad ( Comonad, duplicate, extract, ComonadApply, (<@>) )

-- rel8
import Rel8.Aggregate ( Aggregate )
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( (||.), false )
import qualified Rel8.Expr.Null as Expr
import Rel8.Kind.Context ( Reifiable, contextSing )
import Rel8.Schema.Context.Nullify
  ( Nullifiability( NAggregate, NExpr )
  , NonNullifiability
  , Nullifiable, nullifiability
  , nullifiableOrNot, absurd
  , guarder
  , nullifier
  , unnullifier
  )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable ( HTable )
import Rel8.Schema.HTable.Nullify
  ( HNullify, hnulls, hnullify, hunnullify
  , hguard
  , hproject
  )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Nullity( NotNull, Null ) )
import qualified Rel8.Schema.Result as R
import Rel8.Table
  ( Table, Columns, Context, toColumns, fromColumns
  , FromExprs, fromResult, toResult
  , Transpose
  )
import Rel8.Schema.Spec ( Spec( Spec, nullity ) )
import Rel8.Table.Eq ( EqTable, eqTable )
import Rel8.Table.Ord ( OrdTable, ordTable )
import Rel8.Table.Projection ( Projectable, apply, project )

-- semigroupoids
import Data.Functor.Apply ( Apply, (<.>), liftF2 )
import Data.Functor.Bind ( Bind, (>>-) )
import Data.Functor.Extend ( Extend, duplicated )


type Nullify :: K.Context -> Type -> Type
data Nullify context a
  = Table (Nullifiability context) a
  | Fields (NonNullifiability context) (HNullify (Columns a) (Context a))


instance Projectable (Nullify context) where
  project :: forall a b.
Projecting a b =>
Projection a b -> Nullify context a -> Nullify context b
project Projection a b
f = \case
    Table Nullifiability context
nullifiable a
a -> forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table Nullifiability context
nullifiable (forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f (forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns a
a)))
    Fields NonNullifiability context
nonNullifiable HNullify (Columns a) (Context a)
a -> forall (context :: * -> *) a.
NonNullifiability context
-> HNullify (Columns a) (Context a) -> Nullify context a
Fields NonNullifiability context
nonNullifiable (forall (t :: HTable) (t' :: HTable) (context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HNullify t context -> HNullify t' context
hproject (forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f) HNullify (Columns a) (Context a)
a)


instance Nullifiable context => Functor (Nullify context) where
  fmap :: forall a b. (a -> b) -> Nullify context a -> Nullify context b
fmap a -> b
f = \case
    Table Nullifiability context
nullifiable a
a -> forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table Nullifiability context
nullifiable (a -> b
f a
a)
    Fields NonNullifiability context
notNullifiable HNullify (Columns a) (Context a)
_ -> forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd forall (context :: * -> *).
Nullifiable context =>
Nullifiability context
nullifiability NonNullifiability context
notNullifiable


instance Nullifiable context => Foldable (Nullify context) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Nullify context a -> m
foldMap a -> m
f = \case
    Table Nullifiability context
_ a
a -> a -> m
f a
a
    Fields NonNullifiability context
notNullifiable HNullify (Columns a) (Context a)
_ -> forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd forall (context :: * -> *).
Nullifiable context =>
Nullifiability context
nullifiability NonNullifiability context
notNullifiable


instance Nullifiable context => Traversable (Nullify context) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Nullify context a -> f (Nullify context b)
traverse a -> f b
f = \case
    Table Nullifiability context
nullifiable a
a -> forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table Nullifiability context
nullifiable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    Fields NonNullifiability context
notNullifiable HNullify (Columns a) (Context a)
_ -> forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd forall (context :: * -> *).
Nullifiable context =>
Nullifiability context
nullifiability NonNullifiability context
notNullifiable


instance Nullifiable context => Apply (Nullify context) where
  liftF2 :: forall a b c.
(a -> b -> c)
-> Nullify context a -> Nullify context b -> Nullify context c
liftF2 a -> b -> c
f = \case
    Table Nullifiability context
nullifiable a
a -> \case
      Table Nullifiability context
_ b
b -> forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table Nullifiability context
nullifiable (a -> b -> c
f a
a b
b)
      Fields NonNullifiability context
notNullifiable HNullify (Columns b) (Context b)
_ -> forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd Nullifiability context
nullifiable NonNullifiability context
notNullifiable
    Fields NonNullifiability context
notNullifiable HNullify (Columns a) (Context a)
_ -> forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd forall (context :: * -> *).
Nullifiable context =>
Nullifiability context
nullifiability NonNullifiability context
notNullifiable


instance Nullifiable context => Applicative (Nullify context) where
  pure :: forall a. a -> Nullify context a
pure = forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table forall (context :: * -> *).
Nullifiable context =>
Nullifiability context
nullifiability
  liftA2 :: forall a b c.
(a -> b -> c)
-> Nullify context a -> Nullify context b -> Nullify context c
liftA2 = forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2


instance Nullifiable context => Bind (Nullify context) where
  Table Nullifiability context
_ a
a >>- :: forall a b.
Nullify context a -> (a -> Nullify context b) -> Nullify context b
>>- a -> Nullify context b
f = a -> Nullify context b
f a
a
  Fields NonNullifiability context
notNullifiable HNullify (Columns a) (Context a)
_ >>- a -> Nullify context b
_ = forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd forall (context :: * -> *).
Nullifiable context =>
Nullifiability context
nullifiability NonNullifiability context
notNullifiable


instance Nullifiable context => Monad (Nullify context) where
  >>= :: forall a b.
Nullify context a -> (a -> Nullify context b) -> Nullify context b
(>>=) = forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)


instance Nullifiable context => Extend (Nullify context) where
  duplicated :: forall a. Nullify context a -> Nullify context (Nullify context a)
duplicated = \case
    Table Nullifiability context
nullifiable a
a -> forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table Nullifiability context
nullifiable (forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table Nullifiability context
nullifiable a
a)
    Fields NonNullifiability context
notNullifiable HNullify (Columns a) (Context a)
_ -> forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd forall (context :: * -> *).
Nullifiable context =>
Nullifiability context
nullifiability NonNullifiability context
notNullifiable


instance Nullifiable context => Comonad (Nullify context) where
  extract :: forall a. Nullify context a -> a
extract = \case
    Table Nullifiability context
_ a
a -> a
a
    Fields NonNullifiability context
notNullifiable HNullify (Columns a) (Context a)
_ -> forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd forall (context :: * -> *).
Nullifiable context =>
Nullifiability context
nullifiability NonNullifiability context
notNullifiable
  duplicate :: forall a. Nullify context a -> Nullify context (Nullify context a)
duplicate = forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated


instance Nullifiable context => ComonadApply (Nullify context) where
  <@> :: forall a b.
Nullify context (a -> b) -> Nullify context a -> Nullify context b
(<@>) = forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)


instance (Table context a, Reifiable context, context ~ context') =>
  Table context' (Nullify context a)
 where
  type Columns (Nullify context a) = HNullify (Columns a)
  type Context (Nullify context a) = Context a
  type FromExprs (Nullify context a) = Maybe (FromExprs a)
  type Transpose to (Nullify context a) = Nullify to (Transpose to a)

  fromColumns :: Columns (Nullify context a) context' -> Nullify context a
fromColumns = case forall (context :: * -> *).
SContext context
-> Either (NonNullifiability context) (Nullifiability context)
nullifiableOrNot forall (context :: * -> *). Reifiable context => SContext context
contextSing of
    Left NonNullifiability context
notNullifiable -> forall (context :: * -> *) a.
NonNullifiability context
-> HNullify (Columns a) (Context a) -> Nullify context a
Fields NonNullifiability context
notNullifiable
    Right Nullifiability context
nullifiable ->
      forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table Nullifiability context
nullifiable forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. Spec a -> context (Nullify a) -> m (context a))
-> HNullify t context -> m (t context)
hunnullify (\Spec a
spec -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: * -> *) a.
Nullifiability context
-> Spec a -> context (Nullify a) -> context a
unnullifier Nullifiability context
nullifiable Spec a
spec)

  toColumns :: Nullify context a -> Columns (Nullify context a) context'
toColumns = \case
    Table Nullifiability context
nullifiable a
a -> forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context a -> context (Nullify a))
-> t context -> HNullify t context
hnullify (forall (context :: * -> *) a.
Nullifiability context
-> Spec a -> context a -> context (Nullify a)
nullifier Nullifiability context
nullifiable) (forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns a
a)
    Fields NonNullifiability context
_ HNullify (Columns a) (Context a)
a -> HNullify (Columns a) (Context a)
a

  fromResult :: Columns (Nullify context a) Result -> FromExprs (Nullify context a)
fromResult = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. Spec a -> context (Nullify a) -> m (context a))
-> HNullify t context -> m (t context)
hunnullify forall a. Spec a -> Result (Nullify a) -> Maybe (Result a)
R.unnullifier

  toResult :: FromExprs (Nullify context a) -> Columns (Nullify context a) Result
toResult =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context (Nullify a)) -> HNullify t context
hnulls (forall a b. a -> b -> a
const forall a. Result (Maybe a)
R.null)) (forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context a -> context (Nullify a))
-> t context -> HNullify t context
hnullify forall a. Spec a -> Result a -> Result (Nullify a)
R.nullifier) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @a)


instance (EqTable a, context ~ Expr) => EqTable (Nullify context a) where
  eqTable :: Columns (Nullify context a) (Dict (Sql DBEq))
eqTable = forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context a -> context (Nullify a))
-> t context -> HNullify t context
hnullify (\Spec a
_ Dict (Sql DBEq) a
Dict -> forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict) (forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @a)


instance (OrdTable a, context ~ Expr) => OrdTable (Nullify context a) where
  ordTable :: Columns (Nullify context a) (Dict (Sql DBOrd))
ordTable = forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context a -> context (Nullify a))
-> t context -> HNullify t context
hnullify (\Spec a
_ Dict (Sql DBOrd) a
Dict -> forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict) (forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @a)


aggregateNullify :: ()
  => (exprs -> aggregates)
  -> Nullify Expr exprs
  -> Nullify Aggregate aggregates
aggregateNullify :: forall exprs aggregates.
(exprs -> aggregates)
-> Nullify Expr exprs -> Nullify Aggregate aggregates
aggregateNullify exprs -> aggregates
f = \case
  Table Nullifiability Expr
_ exprs
a -> forall (context :: * -> *) a.
Nullifiability context -> a -> Nullify context a
Table Nullifiability Aggregate
NAggregate (exprs -> aggregates
f exprs
a)
  Fields NonNullifiability Expr
notNullifiable HNullify (Columns exprs) (Context exprs)
_ -> forall (context :: * -> *) a.
Nullifiability context -> NonNullifiability context -> a
absurd Nullifiability Expr
NExpr NonNullifiability Expr
notNullifiable


guard :: (Reifiable context, HTable t)
  => context tag
  -> (tag -> Bool)
  -> (Expr tag -> Expr Bool)
  -> HNullify t context
  -> HNullify t context
guard :: forall (context :: * -> *) (t :: HTable) tag.
(Reifiable context, HTable t) =>
context tag
-> (tag -> Bool)
-> (Expr tag -> Expr Bool)
-> HNullify t context
-> HNullify t context
guard context tag
tag tag -> Bool
isNonNull Expr tag -> Expr Bool
isNonNullExpr =
  forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. context (Maybe a) -> context (Maybe a))
-> HNullify t context -> HNullify t context
hguard (forall (context :: * -> *) tag a.
SContext context
-> context tag
-> (tag -> Bool)
-> (Expr tag -> Expr Bool)
-> context (Maybe a)
-> context (Maybe a)
guarder forall (context :: * -> *). Reifiable context => SContext context
contextSing context tag
tag tag -> Bool
isNonNull Expr tag -> Expr Bool
isNonNullExpr)


isNull :: forall a. Table Expr a => Nullify Expr a -> Expr Bool
isNull :: forall a. Table Expr a => Nullify Expr a -> Expr Bool
isNull =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr Bool
false Any -> Expr Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. Spec a -> context (Nullify a) -> m (context a))
-> HNullify t context -> m (t context)
hunnullify (\Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} Expr (Nullify a)
a -> forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ case Nullity a
nullity of
    Nullity a
NotNull -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Expr Bool -> Any
Any forall a b. (a -> b) -> a -> b
$ forall a. Expr (Maybe a) -> Expr Bool
Expr.isNull Expr (Nullify a)
a
    Nullity a
Null -> forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns


newtype Any = Any
  { Any -> Expr Bool
getAny :: Expr Bool
  }


instance Semigroup Any where
  Any Expr Bool
a <> :: Any -> Any -> Any
<> Any Expr Bool
b = Expr Bool -> Any
Any (Expr Bool
a Expr Bool -> Expr Bool -> Expr Bool
||. Expr Bool
b)