@@ -0,0 +1,135 @@
1+{-# language DataKinds #-}
2+{-# language FlexibleContexts #-}
3+{-# language FlexibleInstances #-}
4+{-# language MultiParamTypeClasses #-}
5+{-# language ScopedTypeVariables #-}
6+{-# language StandaloneKindSignatures #-}
7+{-# language TypeApplications #-}
8+{-# language TypeFamilies #-}
9+{-# language UndecidableInstances #-}
10+
11+module Rel8.Table.Null
12+ ( NullTable(..)
13+ , nullableTable, nullTable, nullifyTable, unsafeUnnullifyTable
14+ , isNullTable, isNonNullTable
15+ , nameNullTable
16+ , toMaybeTable, fromMaybeTable
17+ )
18+where
19+
20+-- base
21+import Data.Kind ( Type )
22+import Prelude hiding ( null, undefined )
23+
24+-- comonad
25+import Control.Comonad ( extract )
26+
27+-- rel8
28+import Rel8.Expr ( Expr )
29+import Rel8.Expr.Bool ( not_ )
30+import Rel8.Kind.Context ( Reifiable )
31+import qualified Rel8.Schema.Kind as K
32+import Rel8.Schema.Name ( Name )
33+import Rel8.Table
34+ ( Table, Columns, Context, fromColumns, toColumns
35+ , FromExprs, fromResult, toResult
36+ , Transpose
37+ )
38+import Rel8.Table.Bool ( bool )
39+import Rel8.Table.Eq ( EqTable, eqTable )
40+import Rel8.Table.Maybe ( MaybeTable, justTable, maybeTable, nothingTable )
41+import Rel8.Table.Nullify ( Nullify, isNull )
42+import Rel8.Table.Ord ( OrdTable, ordTable )
43+import Rel8.Table.Projection ( Projectable, project )
44+import Rel8.Table.Serialize ( ToExprs )
45+import Rel8.Table.Undefined ( undefined )
46+
47+
48+-- | @NullTable t@ is the table @t@, but where all the columns in @t@ have the
49+-- possibility of being 'Rel8.null'. This is very similar to
50+-- 'Rel8.MaybeTable', except that it does not use an extra tag field, so it
51+-- cannot distinguish between @Nothing@ and @Just Nothing@ if nested. In other
52+-- words, if all of the columns of the @t@ passed to @NullTable@ are already
53+-- nullable, then @NullTable@ has no effect.
54+type NullTable :: K.Context -> Type -> Type
55+newtype NullTable context a = NullTable (Nullify context a)
56+
57+
58+instance Projectable (NullTable context) where
59+ project f (NullTable a) = NullTable (project f a)
60+
61+
62+instance (Table context a, Reifiable context, context ~ context') =>
63+ Table context' (NullTable context a)
64+ where
65+ type Columns (NullTable context a) = Columns (Nullify context a)
66+ type Context (NullTable context a) = Context (Nullify context a)
67+ type FromExprs (NullTable context a) = FromExprs (Nullify context a)
68+ type Transpose to (NullTable context a) = NullTable to (Transpose to a)
69+
70+ toColumns (NullTable a) = toColumns a
71+ fromColumns = NullTable . fromColumns
72+
73+ toResult = toResult @_ @(Nullify context a)
74+ fromResult = fromResult @_ @(Nullify context a)
75+
76+
77+instance (EqTable a, context ~ Expr) => EqTable (NullTable context a) where
78+ eqTable = eqTable @(Nullify context a)
79+
80+
81+instance (OrdTable a, context ~ Expr) => OrdTable (NullTable context a) where
82+ ordTable = ordTable @(Nullify context a)
83+
84+
85+instance (ToExprs exprs a, context ~ Expr) =>
86+ ToExprs (NullTable context exprs) (Maybe a)
87+
88+
89+-- | Check if any of the non-nullable fields of @a@ are 'Rel8.null' under the
90+-- 'NullTable'. Returns 'Rel8.false' if @a@ has no non-nullable fields.
91+isNullTable :: Table Expr a => NullTable Expr a -> Expr Bool
92+isNullTable (NullTable a) = isNull a
93+
94+
95+-- | The inverse of 'isNullTable'.
96+isNonNullTable :: Table Expr a => NullTable Expr a -> Expr Bool
97+isNonNullTable = not_ . isNullTable
98+
99+
100+-- | Like 'Rel8.nullable'.
101+nullableTable :: (Table Expr a, Table Expr b)
102+ => b -> (a -> b) -> NullTable Expr a -> b
103+nullableTable b f ma@(NullTable a) = bool (f (extract a)) b (isNullTable ma)
104+
105+
106+-- | The null table. Like 'Rel8.null'.
107+nullTable :: Table Expr a => NullTable Expr a
108+nullTable = NullTable (pure undefined)
109+
110+
111+-- | Lift any table into 'NullTable'. Like 'Rel8.nullify'.
112+nullifyTable :: a -> NullTable Expr a
113+nullifyTable = NullTable . pure
114+
115+
116+unsafeUnnullifyTable :: NullTable Expr a -> a
117+unsafeUnnullifyTable (NullTable a) = extract a
118+
119+
120+-- | Construct a 'NullTable' in the 'Name' context. This can be useful if you
121+-- have a 'NullTable' that you are storing in a table and need to construct a
122+-- 'TableSchema'.
123+nameNullTable :: a -> NullTable Name a
124+nameNullTable = NullTable . pure
125+
126+
127+-- | Convert a 'NullTable' to a 'MaybeTable'.
128+toMaybeTable :: Table Expr a => NullTable Expr a -> MaybeTable Expr a
129+toMaybeTable = nullableTable nothingTable justTable
130+
131+
132+-- | Convert a 'MaybeTable' to a 'NullTable'. Note that if the underlying @a@
133+-- has no non-nullable fields, this is a lossy conversion.
134+fromMaybeTable :: Table Expr a => MaybeTable Expr a -> NullTable Expr a
135+fromMaybeTable = maybeTable nullTable nullifyTable