content: {-# language DataKinds #-}
  {-# language FlexibleContexts #-}
  {-# language FlexibleInstances #-}
  {-# language LambdaCase #-}
  {-# language MultiParamTypeClasses #-}
  {-# language NamedFieldPuns #-}
  {-# language ScopedTypeVariables #-}
  {-# language StandaloneKindSignatures #-}
  {-# language TypeApplications #-}
  {-# language TypeFamilies #-}
  {-# language TypeOperators #-}
  {-# language UndecidableInstances #-}
  
  module Rel8.Table.Nullify
    ( Nullify
    , aggregateNullify
    , guard
    , isNull
    , unsafeUnnullifyTable
    )
  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, (<@>) )
  
  -- profunctors
  import Data.Profunctor (dimap)
  
  -- rel8
  import Rel8.Aggregate (Aggregator')
  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( 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 f = \case
      Table nullifiable a -> Table nullifiable (fromColumns (apply f (toColumns a)))
      Fields nonNullifiable a -> Fields nonNullifiable (hproject (apply f) a)
  
  
  instance Nullifiable context => Functor (Nullify context) where
    fmap f = \case
      Table nullifiable a -> Table nullifiable (f a)
      Fields notNullifiable _ -> absurd nullifiability notNullifiable
  
  
  instance Nullifiable context => Foldable (Nullify context) where
    foldMap f = \case
      Table _ a -> f a
      Fields notNullifiable _ -> absurd nullifiability notNullifiable
  
  
  instance Nullifiable context => Traversable (Nullify context) where
    traverse f = \case
      Table nullifiable a -> Table nullifiable <$> f a
      Fields notNullifiable _ -> absurd nullifiability notNullifiable
  
  
  instance Nullifiable context => Apply (Nullify context) where
    liftF2 f = \case
      Table nullifiable a -> \case
        Table _ b -> Table nullifiable (f a b)
        Fields notNullifiable _ -> absurd nullifiable notNullifiable
      Fields notNullifiable _ -> absurd nullifiability notNullifiable
  
  
  instance Nullifiable context => Applicative (Nullify context) where
    pure = Table nullifiability
    liftA2 = liftF2
  
  
  instance Nullifiable context => Bind (Nullify context) where
    Table _ a >>- f = f a
    Fields notNullifiable _ >>- _ = absurd nullifiability notNullifiable
  
  
  instance Nullifiable context => Monad (Nullify context) where
    (>>=) = (>>-)
  
  
  instance Nullifiable context => Extend (Nullify context) where
    duplicated = \case
      Table nullifiable a -> Table nullifiable (Table nullifiable a)
      Fields notNullifiable _ -> absurd nullifiability notNullifiable
  
  
  instance Nullifiable context => Comonad (Nullify context) where
    extract = \case
      Table _ a -> a
      Fields notNullifiable _ -> absurd nullifiability notNullifiable
    duplicate = duplicated
  
  
  instance Nullifiable context => ComonadApply (Nullify context) where
    (<@>) = (<.>)
  
  
  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 = case nullifiableOrNot contextSing of
      Left notNullifiable -> Fields notNullifiable
      Right nullifiable ->
        Table nullifiable .
        fromColumns .
        runIdentity .
        hunnullify (\spec -> pure . unnullifier nullifiable spec)
  
    toColumns = \case
      Table nullifiable a -> hnullify (nullifier nullifiable) (toColumns a)
      Fields _ a -> a
  
    fromResult = fmap (fromResult @_ @a) . hunnullify R.unnullifier
  
    toResult =
      maybe (hnulls (const R.null)) (hnullify R.nullifier) .
      fmap (toResult @_ @a)
  
  
  instance (EqTable a, context ~ Expr) => EqTable (Nullify context a) where
    eqTable = hnullify (\_ Dict -> Dict) (eqTable @a)
  
  
  instance (OrdTable a, context ~ Expr) => OrdTable (Nullify context a) where
    ordTable = hnullify (\_ Dict -> Dict) (ordTable @a)
  
  
  aggregateNullify :: ()
    => Aggregator' fold i a
    -> Aggregator' fold (Nullify Expr i) (Nullify Expr a)
  aggregateNullify = dimap from to
    where
      from = unsafeUnnullifyTable
      to = Table NExpr
  
  
  guard :: (Reifiable context, HTable t)
    => context tag
    -> (tag -> Bool)
    -> (Expr tag -> Expr Bool)
    -> HNullify t context
    -> HNullify t context
  guard tag isNonNull isNonNullExpr =
    hguard (guarder contextSing tag isNonNull isNonNullExpr)
  
  
  isNull :: forall a. Table Expr a => Nullify Expr a -> Expr Bool
  isNull =
    maybe false getAny .
    getConst .
    hunnullify (\Spec {nullity} a -> Const $ case nullity of
      NotNull -> Just $ Any $ Expr.isNull a
      Null -> Nothing) .
    toColumns
  
  
  unsafeUnnullifyTable :: Nullify Expr a -> a
  unsafeUnnullifyTable = \case
    Table _ a -> a
    Fields notNullifiable _ -> absurd NExpr notNullifiable
  
  
  newtype Any = Any
    { getAny :: Expr Bool
    }
  
  
  instance Semigroup Any where
    Any a <> Any b = Any (a ||. b)
  