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

module Rel8.Table.Maybe
  ( MaybeTable(..)
  , maybeTable, nothingTable, justTable
  , isNothingTable, isJustTable
  , ($?)
  , aggregateMaybeTable
  , nameMaybeTable
  )
where

-- base
import Data.Functor ( ($>) )
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Type )
import Data.Maybe ( fromMaybe, isJust )
import Prelude hiding ( null, undefined )

-- comonad
import Control.Comonad ( extract )

-- rel8
import Rel8.Aggregate ( Aggregate )
import Rel8.Expr ( Expr )
import Rel8.Expr.Aggregate ( groupByExpr )
import Rel8.Expr.Bool ( boolExpr )
import Rel8.Expr.Null ( isNull, isNonNull, null, nullify )
import Rel8.Kind.Context ( Reifiable )
import Rel8.Schema.Dict ( Dict( Dict ) )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.HTable.Identity ( HIdentity(..) )
import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
import Rel8.Schema.Name ( Name )
import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
import qualified Rel8.Schema.Null as N
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
  , FromExprs, fromResult, toResult
  , Transpose
  )
import Rel8.Table.Alternative
  ( AltTable, (<|>:)
  , AlternativeTable, emptyTable
  )
import Rel8.Table.Bool ( bool )
import Rel8.Table.Eq ( EqTable, eqTable )
import Rel8.Table.Ord ( OrdTable, ordTable )
import Rel8.Table.Projection ( Projectable, project )
import Rel8.Table.Nullify ( Nullify, aggregateNullify, guard )
import Rel8.Table.Serialize ( ToExprs )
import Rel8.Table.Undefined ( undefined )
import Rel8.Type ( DBType )
import Rel8.Type.Tag ( MaybeTag( IsJust ) )

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


-- | @MaybeTable t@ is the table @t@, but as the result of an outer join. If
-- the outer join fails to match any rows, this is essentialy @Nothing@, and if
-- the outer join does match rows, this is like @Just@. Unfortunately, SQL
-- makes it impossible to distinguish whether or not an outer join matched any
-- rows based generally on the row contents - if you were to join a row
-- entirely of nulls, you can't distinguish if you matched an all null row, or
-- if the match failed.  For this reason @MaybeTable@ contains an extra field -
-- a "nullTag" - to track whether or not the outer join produced any rows.
type MaybeTable :: K.Context -> Type -> Type
data MaybeTable context a = MaybeTable
  { MaybeTable context a -> context (Maybe MaybeTag)
tag :: context (Maybe MaybeTag)
  , MaybeTable context a -> Nullify context a
just :: Nullify context a
  }
  deriving stock a -> MaybeTable context b -> MaybeTable context a
(a -> b) -> MaybeTable context a -> MaybeTable context b
(forall a b.
 (a -> b) -> MaybeTable context a -> MaybeTable context b)
-> (forall a b. a -> MaybeTable context b -> MaybeTable context a)
-> Functor (MaybeTable context)
forall a b. a -> MaybeTable context b -> MaybeTable context a
forall a b.
(a -> b) -> MaybeTable context a -> MaybeTable context b
forall (context :: Context) a b.
Nullifiable context =>
a -> MaybeTable context b -> MaybeTable context a
forall (context :: Context) a b.
Nullifiable context =>
(a -> b) -> MaybeTable context a -> MaybeTable context b
forall (f :: Context).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MaybeTable context b -> MaybeTable context a
$c<$ :: forall (context :: Context) a b.
Nullifiable context =>
a -> MaybeTable context b -> MaybeTable context a
fmap :: (a -> b) -> MaybeTable context a -> MaybeTable context b
$cfmap :: forall (context :: Context) a b.
Nullifiable context =>
(a -> b) -> MaybeTable context a -> MaybeTable context b
Functor


instance Projectable (MaybeTable context) where
  project :: Projection a b -> MaybeTable context a -> MaybeTable context b
project Projection a b
f (MaybeTable context (Maybe MaybeTag)
tag Nullify context a
a) = context (Maybe MaybeTag)
-> Nullify context b -> MaybeTable context b
forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable context (Maybe MaybeTag)
tag (Projection a b -> Nullify context a -> Nullify context b
forall (f :: Context) a b.
(Projectable f, Projecting a b) =>
Projection a b -> f a -> f b
project Projection a b
f Nullify context a
a)


instance context ~ Expr => Apply (MaybeTable context) where
  MaybeTable context (Maybe MaybeTag)
tag Nullify context (a -> b)
f <.> :: MaybeTable context (a -> b)
-> MaybeTable context a -> MaybeTable context b
<.> MaybeTable context (Maybe MaybeTag)
tag' Nullify context a
a = context (Maybe MaybeTag)
-> Nullify context b -> MaybeTable context b
forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable (context (Maybe MaybeTag)
tag context (Maybe MaybeTag)
-> context (Maybe MaybeTag) -> context (Maybe MaybeTag)
forall a. Semigroup a => a -> a -> a
<> context (Maybe MaybeTag)
tag') (Nullify context (a -> b)
f Nullify context (a -> b) -> Nullify context a -> Nullify context b
forall (f :: Context) a b. Apply f => f (a -> b) -> f a -> f b
<.> Nullify context a
a)


-- | Has the same behavior as the @Applicative@ instance for @Maybe@. See also:
-- 'Rel8.traverseMaybeTable'.
instance context ~ Expr => Applicative (MaybeTable context) where
  <*> :: MaybeTable context (a -> b)
-> MaybeTable context a -> MaybeTable context b
(<*>) = MaybeTable context (a -> b)
-> MaybeTable context a -> MaybeTable context b
forall (f :: Context) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
  pure :: a -> MaybeTable context a
pure = a -> MaybeTable context a
forall a. a -> MaybeTable Expr a
justTable


instance context ~ Expr => Bind (MaybeTable context) where
  MaybeTable context (Maybe MaybeTag)
tag Nullify context a
a >>- :: MaybeTable context a
-> (a -> MaybeTable context b) -> MaybeTable context b
>>- a -> MaybeTable context b
f = case a -> MaybeTable context b
f (Nullify context a -> a
forall (w :: Context) a. Comonad w => w a -> a
extract Nullify context a
a) of
    MaybeTable context (Maybe MaybeTag)
tag' Nullify context b
b -> context (Maybe MaybeTag)
-> Nullify context b -> MaybeTable context b
forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable (context (Maybe MaybeTag)
tag context (Maybe MaybeTag)
-> context (Maybe MaybeTag) -> context (Maybe MaybeTag)
forall a. Semigroup a => a -> a -> a
<> context (Maybe MaybeTag)
tag') Nullify context b
b


-- | Has the same behavior as the @Monad@ instance for @Maybe@.
instance context ~ Expr => Monad (MaybeTable context) where
  >>= :: MaybeTable context a
-> (a -> MaybeTable context b) -> MaybeTable context b
(>>=) = MaybeTable context a
-> (a -> MaybeTable context b) -> MaybeTable context b
forall (m :: Context) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)


instance context ~ Expr => AltTable (MaybeTable context) where
  MaybeTable context a
ma <|>: :: MaybeTable context a
-> MaybeTable context a -> MaybeTable context a
<|>: MaybeTable context a
mb = MaybeTable context a
-> MaybeTable context a -> Expr Bool -> MaybeTable context a
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool MaybeTable context a
ma MaybeTable context a
mb (MaybeTable Expr a -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isNothingTable MaybeTable context a
MaybeTable Expr a
ma)


instance context ~ Expr => AlternativeTable (MaybeTable context) where
  emptyTable :: MaybeTable context a
emptyTable = MaybeTable context a
forall a. Table Expr a => MaybeTable Expr a
nothingTable


instance (context ~ Expr, Table Expr a, Semigroup a) =>
  Semigroup (MaybeTable context a)
 where
  MaybeTable context a
ma <> :: MaybeTable context a
-> MaybeTable context a -> MaybeTable context a
<> MaybeTable context a
mb = MaybeTable context a
-> (a -> MaybeTable context a)
-> MaybeTable Expr a
-> MaybeTable context a
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable MaybeTable context a
mb (\a
a -> MaybeTable context a
-> (a -> MaybeTable context a)
-> MaybeTable Expr a
-> MaybeTable context a
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable MaybeTable context a
ma (a -> MaybeTable Expr a
forall a. a -> MaybeTable Expr a
justTable (a -> MaybeTable Expr a) -> (a -> a) -> a -> MaybeTable Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<>)) MaybeTable context a
MaybeTable Expr a
mb) MaybeTable context a
MaybeTable Expr a
ma


instance (context ~ Expr, Table Expr a, Semigroup a) =>
  Monoid (MaybeTable context a)
 where
  mempty :: MaybeTable context a
mempty = MaybeTable context a
forall a. Table Expr a => MaybeTable Expr a
nothingTable


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

  toColumns :: MaybeTable context a -> Columns (MaybeTable context a) context'
toColumns MaybeTable {context (Maybe MaybeTag)
tag :: context (Maybe MaybeTag)
tag :: forall (context :: Context) a.
MaybeTable context a -> context (Maybe MaybeTag)
tag, Nullify context a
just :: Nullify context a
just :: forall (context :: Context) a.
MaybeTable context a -> Nullify context a
just} = HMaybeTable :: forall (table :: HTable) (context :: Context).
HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
-> HLabel "Just" (HNullify table) context
-> HMaybeTable table context
HMaybeTable
    { htag :: HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
htag = HIdentity (Maybe MaybeTag) context
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (HIdentity (Maybe MaybeTag) context
 -> HLabel "isJust" (HIdentity (Maybe MaybeTag)) context)
-> HIdentity (Maybe MaybeTag) context
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
forall a b. (a -> b) -> a -> b
$ context (Maybe MaybeTag) -> HIdentity (Maybe MaybeTag) context
forall a (context :: Context). context a -> HIdentity a context
HIdentity context (Maybe MaybeTag)
tag
    , hjust :: HLabel "Just" (HNullify (Columns a)) context
hjust = HNullify (Columns a) context
-> HLabel "Just" (HNullify (Columns a)) context
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (HNullify (Columns a) context
 -> HLabel "Just" (HNullify (Columns a)) context)
-> HNullify (Columns a) context
-> HLabel "Just" (HNullify (Columns a)) context
forall a b. (a -> b) -> a -> b
$ context (Maybe MaybeTag)
-> (Maybe MaybeTag -> Bool)
-> (Expr (Maybe MaybeTag) -> Expr Bool)
-> HNullify (Columns a) context
-> HNullify (Columns a) context
forall (context :: Context) (t :: HTable) tag.
(Reifiable context, HTable t) =>
context tag
-> (tag -> Bool)
-> (Expr tag -> Expr Bool)
-> HNullify t context
-> HNullify t context
guard context (Maybe MaybeTag)
tag Maybe MaybeTag -> Bool
forall a. Maybe a -> Bool
isJust Expr (Maybe MaybeTag) -> Expr Bool
forall a. Expr (Maybe a) -> Expr Bool
isNonNull (HNullify (Columns a) context -> HNullify (Columns a) context)
-> HNullify (Columns a) context -> HNullify (Columns a) context
forall a b. (a -> b) -> a -> b
$ Nullify context a -> Columns (Nullify context a) context'
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns Nullify context a
just
    }

  fromColumns :: Columns (MaybeTable context a) context' -> MaybeTable context a
fromColumns HMaybeTable {htag, hjust} = MaybeTable :: forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable
    { tag :: context (Maybe MaybeTag)
tag = HIdentity (Maybe MaybeTag) context -> context (Maybe MaybeTag)
forall a (context :: Context). HIdentity a context -> context a
unHIdentity (HIdentity (Maybe MaybeTag) context -> context (Maybe MaybeTag))
-> HIdentity (Maybe MaybeTag) context -> context (Maybe MaybeTag)
forall a b. (a -> b) -> a -> b
$ HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
-> HIdentity (Maybe MaybeTag) context
forall (label :: Symbol) (t :: HTable) (context :: Context).
HLabel label t context -> t context
hunlabel HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
htag
    , just :: Nullify context a
just = Columns (Nullify context a) context' -> Nullify context a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (Nullify context a) context' -> Nullify context a)
-> Columns (Nullify context a) context' -> Nullify context a
forall a b. (a -> b) -> a -> b
$ HLabel "Just" (HNullify (Columns a)) context
-> HNullify (Columns a) context
forall (label :: Symbol) (t :: HTable) (context :: Context).
HLabel label t context -> t context
hunlabel HLabel "Just" (HNullify (Columns a)) context
hjust
    }

  toResult :: FromExprs (MaybeTable context a)
-> Columns (MaybeTable context a) Result
toResult FromExprs (MaybeTable context a)
ma = HMaybeTable :: forall (table :: HTable) (context :: Context).
HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
-> HLabel "Just" (HNullify table) context
-> HMaybeTable table context
HMaybeTable
    { htag :: HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
htag = HIdentity (Maybe MaybeTag) Result
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Identity (Maybe MaybeTag) -> HIdentity (Maybe MaybeTag) Result
forall a (context :: Context). context a -> HIdentity a context
HIdentity (Maybe MaybeTag -> Identity (Maybe MaybeTag)
forall a. a -> Identity a
Identity (MaybeTag
IsJust MaybeTag -> Maybe (FromExprs a) -> Maybe MaybeTag
forall (f :: Context) a b. Functor f => a -> f b -> f a
<$ Maybe (FromExprs a)
FromExprs (MaybeTable context a)
ma)))
    , hjust :: HLabel "Just" (HNullify (Columns a)) Result
hjust = HNullify (Columns a) Result
-> HLabel "Just" (HNullify (Columns a)) Result
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (FromExprs (Nullify context a) -> Columns (Nullify context a) Result
forall (context :: Context) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context a) FromExprs (Nullify context a)
FromExprs (MaybeTable context a)
ma)
    }

  fromResult :: Columns (MaybeTable context a) Result
-> FromExprs (MaybeTable context a)
fromResult HMaybeTable {htag, hjust} = case HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
-> HIdentity (Maybe MaybeTag) Result
forall (label :: Symbol) (t :: HTable) (context :: Context).
HLabel label t context -> t context
hunlabel HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
htag of
    HIdentity (Identity Maybe MaybeTag
tag) -> Maybe MaybeTag
tag Maybe MaybeTag -> FromExprs a -> Maybe (FromExprs a)
forall (f :: Context) a b. Functor f => f a -> b -> f b
$>
      FromExprs a -> Maybe (FromExprs a) -> FromExprs a
forall a. a -> Maybe a -> a
fromMaybe FromExprs a
forall a. a
err (Columns (Nullify context a) Result -> FromExprs (Nullify context a)
forall (context :: Context) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @(Nullify context a) (HLabel "Just" (HNullify (Columns a)) Result
-> HNullify (Columns a) Result
forall (label :: Symbol) (t :: HTable) (context :: Context).
HLabel label t context -> t context
hunlabel HLabel "Just" (HNullify (Columns a)) Result
hjust))
    where
      err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Maybe.fromColumns: mismatch between tag and data"


instance (EqTable a, context ~ Expr) => EqTable (MaybeTable context a) where
  eqTable :: Columns (MaybeTable context a) (Dict (Sql DBEq))
eqTable = HMaybeTable :: forall (table :: HTable) (context :: Context).
HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
-> HLabel "Just" (HNullify table) context
-> HMaybeTable table context
HMaybeTable
    { htag :: HLabel "isJust" (HIdentity (Maybe MaybeTag)) (Dict (Sql DBEq))
htag = HIdentity (Maybe MaybeTag) (Dict (Sql DBEq))
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) (Dict (Sql DBEq))
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Dict (Sql DBEq) (Maybe MaybeTag)
-> HIdentity (Maybe MaybeTag) (Dict (Sql DBEq))
forall a (context :: Context). context a -> HIdentity a context
HIdentity Dict (Sql DBEq) (Maybe MaybeTag)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
    , hjust :: HLabel "Just" (HNullify (Columns a)) (Dict (Sql DBEq))
hjust = HNullify (Columns a) (Dict (Sql DBEq))
-> HLabel "Just" (HNullify (Columns a)) (Dict (Sql DBEq))
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (EqTable (Nullify context a) =>
Columns (Nullify context a) (Dict (Sql DBEq))
forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @(Nullify context a))
    }


instance (OrdTable a, context ~ Expr) => OrdTable (MaybeTable context a) where
  ordTable :: Columns (MaybeTable context a) (Dict (Sql DBOrd))
ordTable = HMaybeTable :: forall (table :: HTable) (context :: Context).
HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
-> HLabel "Just" (HNullify table) context
-> HMaybeTable table context
HMaybeTable
    { htag :: HLabel "isJust" (HIdentity (Maybe MaybeTag)) (Dict (Sql DBOrd))
htag = HIdentity (Maybe MaybeTag) (Dict (Sql DBOrd))
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) (Dict (Sql DBOrd))
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Dict (Sql DBOrd) (Maybe MaybeTag)
-> HIdentity (Maybe MaybeTag) (Dict (Sql DBOrd))
forall a (context :: Context). context a -> HIdentity a context
HIdentity Dict (Sql DBOrd) (Maybe MaybeTag)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
    , hjust :: HLabel "Just" (HNullify (Columns a)) (Dict (Sql DBOrd))
hjust = HNullify (Columns a) (Dict (Sql DBOrd))
-> HLabel "Just" (HNullify (Columns a)) (Dict (Sql DBOrd))
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (OrdTable (Nullify context a) =>
Columns (Nullify context a) (Dict (Sql DBOrd))
forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @(Nullify context a))
    }


instance (ToExprs exprs a, context ~ Expr) =>
  ToExprs (MaybeTable context exprs) (Maybe a)


-- | Check if a @MaybeTable@ is absent of any row. Like 'Data.Maybe.isNothing'.
isNothingTable :: MaybeTable Expr a -> Expr Bool
isNothingTable :: MaybeTable Expr a -> Expr Bool
isNothingTable (MaybeTable Expr (Maybe MaybeTag)
tag Nullify Expr a
_) = Expr (Maybe MaybeTag) -> Expr Bool
forall a. Expr (Maybe a) -> Expr Bool
isNull Expr (Maybe MaybeTag)
tag


-- | Check if a @MaybeTable@ contains a row. Like 'Data.Maybe.isJust'.
isJustTable :: MaybeTable Expr a -> Expr Bool
isJustTable :: MaybeTable Expr a -> Expr Bool
isJustTable (MaybeTable Expr (Maybe MaybeTag)
tag Nullify Expr a
_) = Expr (Maybe MaybeTag) -> Expr Bool
forall a. Expr (Maybe a) -> Expr Bool
isNonNull Expr (Maybe MaybeTag)
tag


-- | Perform case analysis on a 'MaybeTable'. Like 'maybe'.
maybeTable :: Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable :: b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable b
b a -> b
f ma :: MaybeTable Expr a
ma@(MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr a
a) = b -> b -> Expr Bool -> b
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool (a -> b
f (Nullify Expr a -> a
forall (w :: Context) a. Comonad w => w a -> a
extract Nullify Expr a
a)) b
b (MaybeTable Expr a -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isNothingTable MaybeTable Expr a
ma)
{-# INLINABLE maybeTable #-}


-- | The null table. Like 'Nothing'.
nothingTable :: Table Expr a => MaybeTable Expr a
nothingTable :: MaybeTable Expr a
nothingTable = Expr (Maybe MaybeTag) -> Nullify Expr a -> MaybeTable Expr a
forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable Expr (Maybe MaybeTag)
forall a. DBType a => Expr (Maybe a)
null (a -> Nullify Expr a
forall (f :: Context) a. Applicative f => a -> f a
pure a
forall a. Table Expr a => a
undefined)


-- | Lift any table into 'MaybeTable'. Like 'Just'. Note you can also use
-- 'pure'.
justTable :: a -> MaybeTable Expr a
justTable :: a -> MaybeTable Expr a
justTable = Expr (Maybe MaybeTag) -> Nullify Expr a -> MaybeTable Expr a
forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable Expr (Maybe MaybeTag)
forall a. Monoid a => a
mempty (Nullify Expr a -> MaybeTable Expr a)
-> (a -> Nullify Expr a) -> a -> MaybeTable Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Nullify Expr a
forall (f :: Context) a. Applicative f => a -> f a
pure


-- | Project a single expression out of a 'MaybeTable'. You can think of this
-- operator like the '$' operator, but it also has the ability to return
-- @null@.
($?) :: forall a b. Sql DBType b
  => (a -> Expr b) -> MaybeTable Expr a -> Expr (N.Nullify b)
a -> Expr b
f $? :: (a -> Expr b) -> MaybeTable Expr a -> Expr (Nullify b)
$? ma :: MaybeTable Expr a
ma@(MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr a
a) = case Nullable b => Nullity b
forall a. Nullable a => Nullity a
nullable @b of
  Nullity b
Null -> Expr b -> Expr b -> Expr Bool -> Expr b
forall a. Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr (a -> Expr b
f (Nullify Expr a -> a
forall (w :: Context) a. Comonad w => w a -> a
extract Nullify Expr a
a)) Expr b
forall a. DBType a => Expr (Maybe a)
null (MaybeTable Expr a -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isNothingTable MaybeTable Expr a
ma)
  Nullity b
NotNull -> Expr (Maybe b) -> Expr (Maybe b) -> Expr Bool -> Expr (Maybe b)
forall a. Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr (Expr b -> Expr (Maybe b)
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify (a -> Expr b
f (Nullify Expr a -> a
forall (w :: Context) a. Comonad w => w a -> a
extract Nullify Expr a
a))) Expr (Maybe b)
forall a. DBType a => Expr (Maybe a)
null (MaybeTable Expr a -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isNothingTable MaybeTable Expr a
ma)
infixl 4 $?


-- | Lift an aggregating function to operate on a 'MaybeTable'.
-- @nothingTable@s and @justTable@s are grouped separately.
aggregateMaybeTable :: ()
  => (exprs -> aggregates)
  -> MaybeTable Expr exprs
  -> MaybeTable Aggregate aggregates
aggregateMaybeTable :: (exprs -> aggregates)
-> MaybeTable Expr exprs -> MaybeTable Aggregate aggregates
aggregateMaybeTable exprs -> aggregates
f (MaybeTable Expr (Maybe MaybeTag)
tag Nullify Expr exprs
a) =
  Aggregate (Maybe MaybeTag)
-> Nullify Aggregate aggregates -> MaybeTable Aggregate aggregates
forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable (Expr (Maybe MaybeTag) -> Aggregate (Maybe MaybeTag)
forall a. Sql DBEq a => Expr a -> Aggregate a
groupByExpr Expr (Maybe MaybeTag)
tag) ((exprs -> aggregates)
-> Nullify Expr exprs -> Nullify Aggregate aggregates
forall exprs aggregates.
(exprs -> aggregates)
-> Nullify Expr exprs -> Nullify Aggregate aggregates
aggregateNullify exprs -> aggregates
f Nullify Expr exprs
a)


-- | Construct a 'MaybeTable' in the 'Name' context. This can be useful if you
-- have a 'MaybeTable' that you are storing in a table and need to construct a
-- 'TableSchema'.
nameMaybeTable
  :: Name (Maybe MaybeTag)
     -- ^ The name of the column to track whether a row is a 'justTable' or
     -- 'nothingTable'.
  -> a
     -- ^ Names of the columns in @a@.
  -> MaybeTable Name a
nameMaybeTable :: Name (Maybe MaybeTag) -> a -> MaybeTable Name a
nameMaybeTable Name (Maybe MaybeTag)
tag = Name (Maybe MaybeTag) -> Nullify Name a -> MaybeTable Name a
forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable Name (Maybe MaybeTag)
tag (Nullify Name a -> MaybeTable Name a)
-> (a -> Nullify Name a) -> a -> MaybeTable Name a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Nullify Name a
forall (f :: Context) a. Applicative f => a -> f a
pure