{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language DeriveAnyClass #-}
{-# language DerivingStrategies #-}
{-# language DeriveGeneric #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language QuantifiedConstraints #-}
{-# language RankNTypes #-}
{-# language RecordWildCards #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Schema.HTable.Nullify
  ( HNullify( HNullify )
  , Nullify
  , hguard
  , hnulls
  , hnullify
  , hunnullify
  , hproject
  )
where

-- base
import Data.Kind ( Type )
import GHC.Generics ( Generic )
import Prelude hiding ( null )

-- rel8
import Rel8.FCF ( Eval, Exp )
import Rel8.Schema.HTable ( HTable, hfield, htabulate, htabulateA, hspecs )
import Rel8.Schema.HTable.MapTable
  ( HMapTable, HMapTableField( HMapTableField )
  , MapSpec, mapInfo
  )
import qualified Rel8.Schema.HTable.MapTable as HMapTable ( hproject )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
import qualified Rel8.Schema.Null as Type ( Nullify )
import Rel8.Schema.Spec ( Spec(..) )

-- semigroupoids
import Data.Functor.Apply ( Apply )


type HNullify :: K.HTable -> K.HTable
newtype HNullify table context = HNullify (HMapTable Nullify table context)
  deriving stock forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (table :: HTable) (context :: * -> *) x.
Rep (HNullify table context) x -> HNullify table context
forall (table :: HTable) (context :: * -> *) x.
HNullify table context -> Rep (HNullify table context) x
$cto :: forall (table :: HTable) (context :: * -> *) x.
Rep (HNullify table context) x -> HNullify table context
$cfrom :: forall (table :: HTable) (context :: * -> *) x.
HNullify table context -> Rep (HNullify table context) x
Generic
  deriving anyclass forall (table :: HTable). HTable table => HNullify table Spec
forall (table :: HTable) (c :: * -> Constraint).
(HTable table, HConstrainTable (HNullify table) c) =>
HNullify table (Dict c)
forall (table :: HTable) (context :: * -> *).
HTable table =>
(forall a. HField (HNullify table) a -> context a)
-> HNullify table context
forall (table :: HTable) (context :: * -> *) a.
HTable table =>
HNullify table context -> HField (HNullify table) a -> context a
forall (table :: HTable) (m :: * -> *) (f :: * -> *) (g :: * -> *).
(HTable table, Apply m) =>
(forall a. f a -> m (g a))
-> HNullify table f -> m (HNullify table g)
forall (t :: HTable).
(forall (context :: * -> *) a.
 t context -> HField t a -> context a)
-> (forall (context :: * -> *).
    (forall a. HField t a -> context a) -> t context)
-> (forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
    Apply m =>
    (forall a. f a -> m (g a)) -> t f -> m (t g))
-> (forall (c :: * -> Constraint).
    HConstrainTable t c =>
    t (Dict c))
-> t Spec
-> HTable t
hspecs :: HNullify table Spec
$chspecs :: forall (table :: HTable). HTable table => HNullify table Spec
hdicts :: forall (c :: * -> Constraint).
HConstrainTable (HNullify table) c =>
HNullify table (Dict c)
$chdicts :: forall (table :: HTable) (c :: * -> Constraint).
(HTable table, HConstrainTable (HNullify table) c) =>
HNullify table (Dict c)
htraverse :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Apply m =>
(forall a. f a -> m (g a))
-> HNullify table f -> m (HNullify table g)
$chtraverse :: forall (table :: HTable) (m :: * -> *) (f :: * -> *) (g :: * -> *).
(HTable table, Apply m) =>
(forall a. f a -> m (g a))
-> HNullify table f -> m (HNullify table g)
htabulate :: forall (context :: * -> *).
(forall a. HField (HNullify table) a -> context a)
-> HNullify table context
$chtabulate :: forall (table :: HTable) (context :: * -> *).
HTable table =>
(forall a. HField (HNullify table) a -> context a)
-> HNullify table context
hfield :: forall (context :: * -> *) a.
HNullify table context -> HField (HNullify table) a -> context a
$chfield :: forall (table :: HTable) (context :: * -> *) a.
HTable table =>
HNullify table context -> HField (HNullify table) a -> context a
HTable


-- | Transform a 'Type' by allowing it to be @null@.
data Nullify :: Type -> Exp Type
type instance Eval (Nullify a) = Type.Nullify a


instance MapSpec Nullify where
  mapInfo :: forall x. Spec x -> Spec (Eval (Nullify x))
mapInfo = \case
    Spec {Nullity x
nullity :: forall a. Spec a -> Nullity a
nullity :: Nullity x
nullity, [String]
TypeInformation (Unnullify x)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
labels :: forall a. Spec a -> [String]
info :: TypeInformation (Unnullify x)
labels :: [String]
..} -> Spec
      { nullity :: Nullity (Maybe (Unnullify x))
nullity = case Nullity x
nullity of
          Nullity x
Null    -> forall a. NotNull a => Nullity (Maybe a)
Null
          Nullity x
NotNull -> forall a. NotNull a => Nullity (Maybe a)
Null
      , [String]
TypeInformation (Unnullify x)
info :: TypeInformation (Unnullify (Maybe (Unnullify x)))
labels :: [String]
info :: TypeInformation (Unnullify x)
labels :: [String]
..
      }


hguard :: HTable t
  => (forall a. context (Maybe a) -> context (Maybe a))
  -> HNullify t context -> HNullify t context
hguard :: forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. context (Maybe a) -> context (Maybe a))
-> HNullify t context -> HNullify t context
hguard forall a. context (Maybe a) -> context (Maybe a)
guarder (HNullify HMapTable Nullify t context
as) = forall (table :: HTable) (context :: * -> *).
HMapTable Nullify table context -> HNullify table context
HNullify forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate forall a b. (a -> b) -> a -> b
$ \(HMapTableField HField t a
field) ->
  case forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
    Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} -> case forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield HMapTable Nullify t context
as (forall (t :: HTable) a (f :: * -> * -> *).
HField t a -> HMapTableField f t (Eval (f a))
HMapTableField HField t a
field) of
      context (Eval (Nullify a))
a -> case Nullity a
nullity of
        Nullity a
Null -> forall a. context (Maybe a) -> context (Maybe a)
guarder context (Eval (Nullify a))
a
        Nullity a
NotNull -> forall a. context (Maybe a) -> context (Maybe a)
guarder context (Eval (Nullify a))
a


hnulls :: HTable t
  => (forall a. Spec a -> context (Type.Nullify a))
  -> HNullify t context
hnulls :: forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context (Nullify a)) -> HNullify t context
hnulls forall a. Spec a -> context (Nullify a)
null = forall (table :: HTable) (context :: * -> *).
HMapTable Nullify table context -> HNullify table context
HNullify forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate forall a b. (a -> b) -> a -> b
$ \(HMapTableField HField t a
field) ->
  case forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
    spec :: Spec a
spec@Spec {} -> forall a. Spec a -> context (Nullify a)
null Spec a
spec
{-# INLINABLE hnulls #-}


hnullify :: HTable t
  => (forall a. Spec a -> context a -> context (Type.Nullify a))
  -> t context
  -> HNullify t context
hnullify :: 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 -> context a -> context (Nullify a)
nullifier t context
a = forall (table :: HTable) (context :: * -> *).
HMapTable Nullify table context -> HNullify table context
HNullify forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate forall a b. (a -> b) -> a -> b
$ \(HMapTableField HField t a
field) ->
  case forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
    spec :: Spec a
spec@Spec {} -> forall a. Spec a -> context a -> context (Nullify a)
nullifier Spec a
spec (forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield t context
a HField t a
field)
{-# INLINABLE hnullify #-}


hunnullify :: (HTable t, Apply m)
  => (forall a. Spec a -> context (Type.Nullify a) -> m (context a))
  -> HNullify t context
  -> m (t context)
hunnullify :: 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 -> context (Nullify a) -> m (context a)
unnullifier (HNullify HMapTable Nullify t context
as) =
  forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA forall a b. (a -> b) -> a -> b
$ \HField t a
field -> case forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
    spec :: Spec a
spec@Spec {} -> case forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield HMapTable Nullify t context
as (forall (t :: HTable) a (f :: * -> * -> *).
HField t a -> HMapTableField f t (Eval (f a))
HMapTableField HField t a
field) of
      context (Eval (Nullify a))
a -> forall a. Spec a -> context (Nullify a) -> m (context a)
unnullifier Spec a
spec context (Eval (Nullify a))
a
{-# INLINABLE hunnullify #-}


hproject :: ()
  => (forall ctx. t ctx -> t' ctx)
  -> HNullify t context -> HNullify t' context
hproject :: forall (t :: HTable) (t' :: HTable) (context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HNullify t context -> HNullify t' context
hproject forall (ctx :: * -> *). t ctx -> t' ctx
f (HNullify HMapTable Nullify t context
a) = forall (table :: HTable) (context :: * -> *).
HMapTable Nullify table context -> HNullify table context
HNullify (forall (t :: HTable) (t' :: HTable) (f :: * -> * -> *)
       (context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HMapTable f t context -> HMapTable f t' context
HMapTable.hproject forall (ctx :: * -> *). t ctx -> t' ctx
f HMapTable Nullify t context
a)