{-# 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 x.
 HNullify table context -> Rep (HNullify table context) x)
-> (forall x.
    Rep (HNullify table context) x -> HNullify table context)
-> Generic (HNullify table context)
forall x. Rep (HNullify table context) x -> HNullify table context
forall x. HNullify table context -> Rep (HNullify table context) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (table :: HTable) (context :: Context) x.
Rep (HNullify table context) x -> HNullify table context
forall (table :: HTable) (context :: Context) x.
HNullify table context -> Rep (HNullify table context) x
$cto :: forall (table :: HTable) (context :: Context) x.
Rep (HNullify table context) x -> HNullify table context
$cfrom :: forall (table :: HTable) (context :: Context) x.
HNullify table context -> Rep (HNullify table context) x
Generic
  deriving anyclass HNullify table Spec
(forall (context :: Context) a.
 HNullify table context -> HField (HNullify table) a -> context a)
-> (forall (context :: Context).
    (forall a. HField (HNullify table) a -> context a)
    -> HNullify table context)
-> (forall (m :: Context) (f :: Context) (g :: Context).
    Apply m =>
    (forall a. f a -> m (g a))
    -> HNullify table f -> m (HNullify table g))
-> (forall (c :: * -> Constraint).
    HConstrainTable (HNullify table) c =>
    HNullify table (Dict c))
-> HNullify table Spec
-> HTable (HNullify table)
forall (c :: * -> Constraint).
HConstrainTable (HNullify table) c =>
HNullify table (Dict c)
forall (context :: Context).
(forall a. HField (HNullify table) a -> context a)
-> HNullify table context
forall (context :: Context) a.
HNullify table context -> HField (HNullify table) a -> context a
forall (m :: Context) (f :: Context) (g :: Context).
Apply m =>
(forall a. f a -> m (g a))
-> HNullify table f -> m (HNullify table g)
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 :: Context).
HTable table =>
(forall a. HField (HNullify table) a -> context a)
-> HNullify table context
forall (table :: HTable) (context :: Context) a.
HTable table =>
HNullify table context -> HField (HNullify table) a -> context a
forall (table :: HTable) (m :: Context) (f :: Context)
       (g :: Context).
(HTable table, Apply m) =>
(forall a. f a -> m (g a))
-> HNullify table f -> m (HNullify table g)
forall (t :: HTable).
(forall (context :: Context) a.
 t context -> HField t a -> context a)
-> (forall (context :: Context).
    (forall a. HField t a -> context a) -> t context)
-> (forall (m :: Context) (f :: Context) (g :: Context).
    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 :: HNullify table (Dict c)
$chdicts :: forall (table :: HTable) (c :: * -> Constraint).
(HTable table, HConstrainTable (HNullify table) c) =>
HNullify table (Dict c)
htraverse :: (forall a. f a -> m (g a))
-> HNullify table f -> m (HNullify table g)
$chtraverse :: forall (table :: HTable) (m :: Context) (f :: Context)
       (g :: Context).
(HTable table, Apply m) =>
(forall a. f a -> m (g a))
-> HNullify table f -> m (HNullify table g)
htabulate :: (forall a. HField (HNullify table) a -> context a)
-> HNullify table context
$chtabulate :: forall (table :: HTable) (context :: Context).
HTable table =>
(forall a. HField (HNullify table) a -> context a)
-> HNullify table context
hfield :: HNullify table context -> HField (HNullify table) a -> context a
$chfield :: forall (table :: HTable) (context :: 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 :: 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 :: forall a.
[String] -> TypeInformation (Unnullify a) -> Nullity a -> Spec a
Spec
      { nullity :: Nullity (Maybe (Unnullify x))
nullity = case Nullity x
nullity of
          Nullity x
Null    -> Nullity (Maybe (Unnullify x))
forall a. NotNull a => Nullity (Maybe a)
Null
          Nullity x
NotNull -> Nullity (Maybe (Unnullify x))
forall a. NotNull a => Nullity (Maybe a)
Null
      , [String]
TypeInformation (Unnullify x)
TypeInformation
  (Unnullify' (IsMaybe (Maybe (Unnullify x))) (Maybe (Unnullify x)))
info :: TypeInformation
  (Unnullify' (IsMaybe (Maybe (Unnullify x))) (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 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) = HMapTable Nullify t context -> HNullify t context
forall (table :: HTable) (context :: Context).
HMapTable Nullify table context -> HNullify table context
HNullify (HMapTable Nullify t context -> HNullify t context)
-> HMapTable Nullify t context -> HNullify t context
forall a b. (a -> b) -> a -> b
$ (forall a. HField (HMapTable Nullify t) a -> context a)
-> HMapTable Nullify t context
forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (HMapTable Nullify t) a -> context a)
 -> HMapTable Nullify t context)
-> (forall a. HField (HMapTable Nullify t) a -> context a)
-> HMapTable Nullify t context
forall a b. (a -> b) -> a -> b
$ \(HMapTableField field) ->
  case t Spec -> HField t a -> Spec a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield t Spec
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 HMapTable Nullify t context
-> HField (HMapTable Nullify t) (Maybe (Unnullify' (IsMaybe a) a))
-> context (Maybe (Unnullify' (IsMaybe a) a))
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield HMapTable Nullify t context
as (HField t a -> HMapTableField Nullify t (Eval (Nullify a))
forall (t :: HTable) a (f :: * -> Context).
HField t a -> HMapTableField f t (Eval (f a))
HMapTableField HField t a
field) of
      context (Maybe (Unnullify' (IsMaybe a) a))
a -> case Nullity a
nullity of
        Nullity a
Null -> context (Maybe (Unnullify' (IsMaybe a) a))
-> context (Maybe (Unnullify' (IsMaybe a) a))
forall a. context (Maybe a) -> context (Maybe a)
guarder context (Maybe (Unnullify' (IsMaybe a) a))
a
        Nullity a
NotNull -> context (Maybe a) -> context (Maybe a)
forall a. context (Maybe a) -> context (Maybe a)
guarder context (Maybe a)
context (Maybe (Unnullify' (IsMaybe a) a))
a


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


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