git.iko.soy/rel8
on 7c5422f help sign in
rel8/src/Rel8/Table/Nullify.hs
182 lines 5.4 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleInstances #-}
3{-# language LambdaCase #-}
4{-# language MultiParamTypeClasses #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
8{-# language TypeFamilies #-}
9{-# language UndecidableInstances #-}
11module Rel8.Table.Nullify
12 ( Nullify
13 , aggregateNullify
14 , guard
15 )
16where
18-- base
19import Control.Applicative ( liftA2 )
20import Data.Functor.Identity ( runIdentity )
21import Data.Kind ( Type )
22import Prelude
24-- comonad
25import Control.Comonad ( Comonad, duplicate, extract, ComonadApply, (<@>) )
27-- rel8
28import Rel8.Aggregate ( Aggregate )
29import Rel8.Expr ( Expr )
30import Rel8.Kind.Context ( Reifiable, contextSing )
31import Rel8.Schema.Context ( Col )
32import Rel8.Schema.Context.Nullify
33 ( Nullifiability( NAggregate, NExpr )
34 , NonNullifiability
35 , Nullifiable, nullifiability
36 , nullifiableOrNot, absurd
37 , guarder
38 , nullifier
39 , unnullifier
40 )
41import Rel8.Schema.Dict ( Dict( Dict ) )
42import Rel8.Schema.HTable ( HTable )
43import Rel8.Schema.HTable.Nullify ( HNullify, hnulls, hnullify, hunnullify, hguard )
44import qualified Rel8.Schema.Kind as K
45import qualified Rel8.Schema.Result as R
46import Rel8.Schema.Spec ( Spec( Spec ) )
47import Rel8.Table
48 ( Table, Columns, Context, toColumns, fromColumns
49 , FromExprs, fromResult, toResult
50 )
51import Rel8.Table.Eq ( EqTable, eqTable )
52import Rel8.Table.Ord ( OrdTable, ordTable )
53import Rel8.Table.Recontextualize ( Recontextualize )
55-- semigroupoids
56import Data.Functor.Apply ( Apply, (<.>), liftF2 )
57import Data.Functor.Bind ( Bind, (>>-) )
58import Data.Functor.Extend ( Extend, duplicated )
61type Nullify :: K.Context -> Type -> Type
62data Nullify context a
63 = Table (Nullifiability context) a
64 | Fields (NonNullifiability context) (HNullify (Columns a) (Col (Context a)))
67instance Nullifiable context => Functor (Nullify context) where
68 fmap f = \case
69 Table nullifiable a -> Table nullifiable (f a)
70 Fields notNullifiable _ -> absurd nullifiability notNullifiable
73instance Nullifiable context => Foldable (Nullify context) where
74 foldMap f = \case
75 Table _ a -> f a
76 Fields notNullifiable _ -> absurd nullifiability notNullifiable
79instance Nullifiable context => Traversable (Nullify context) where
80 traverse f = \case
81 Table nullifiable a -> Table nullifiable <$> f a
82 Fields notNullifiable _ -> absurd nullifiability notNullifiable
85instance Nullifiable context => Apply (Nullify context) where
86 liftF2 f = \case
87 Table nullifiable a -> \case
88 Table _ b -> Table nullifiable (f a b)
89 Fields notNullifiable _ -> absurd nullifiable notNullifiable
90 Fields notNullifiable _ -> absurd nullifiability notNullifiable
93instance Nullifiable context => Applicative (Nullify context) where
94 pure = Table nullifiability
95 liftA2 = liftF2
98instance Nullifiable context => Bind (Nullify context) where
99 Table _ a >>- f = f a
100 Fields notNullifiable _ >>- _ = absurd nullifiability notNullifiable
103instance Nullifiable context => Monad (Nullify context) where
104 (>>=) = (>>-)
107instance Nullifiable context => Extend (Nullify context) where
108 duplicated = \case
109 Table nullifiable a -> Table nullifiable (Table nullifiable a)
110 Fields notNullifiable _ -> absurd nullifiability notNullifiable
113instance Nullifiable context => Comonad (Nullify context) where
114 extract = \case
115 Table _ a -> a
116 Fields notNullifiable _ -> absurd nullifiability notNullifiable
117 duplicate = duplicated
120instance Nullifiable context => ComonadApply (Nullify context) where
121 (<@>) = (<.>)
124instance (Table context a, Reifiable context, context ~ context') =>
125 Table context' (Nullify context a)
126 where
127 type Columns (Nullify context a) = HNullify (Columns a)
128 type Context (Nullify context a) = Context a
129 type FromExprs (Nullify context a) = Maybe (FromExprs a)
131 fromColumns = case nullifiableOrNot contextSing of
132 Left notNullifiable -> Fields notNullifiable
133 Right nullifiable ->
134 Table nullifiable .
135 fromColumns .
136 runIdentity .
137 hunnullify (\spec -> pure . unnullifier nullifiable spec)
139 toColumns = \case
140 Table nullifiable a -> hnullify (nullifier nullifiable) (toColumns a)
141 Fields _ a -> a
143 fromResult = fmap (fromResult @_ @a) . hunnullify R.unnullifier
145 toResult =
146 maybe (hnulls (const R.null)) (hnullify R.nullifier) .
147 fmap (toResult @_ @a)
150instance
151 ( Recontextualize from to a b
152 , Reifiable from, from ~ from'
153 , Reifiable to, to ~ to'
154 )
155 => Recontextualize from' to' (Nullify from a) (Nullify to b)
158instance (EqTable a, context ~ Expr) => EqTable (Nullify context a) where
159 eqTable = hnullify (\_ Dict -> Dict) (eqTable @a)
162instance (OrdTable a, context ~ Expr) => OrdTable (Nullify context a) where
163 ordTable = hnullify (\_ Dict -> Dict) (ordTable @a)
166aggregateNullify :: ()
167 => (exprs -> aggregates)
168 -> Nullify Expr exprs
169 -> Nullify Aggregate aggregates
170aggregateNullify f = \case
171 Table _ a -> Table NAggregate (f a)
172 Fields notNullifiable _ -> absurd NExpr notNullifiable
175guard :: (Reifiable context, HTable t)
176 => Col context ('Spec tag)
177 -> (tag -> Bool)
178 -> (Expr tag -> Expr Bool)
179 -> HNullify t (Col context)
180 -> HNullify t (Col context)
181guard tag isNonNull isNonNullExpr =
182 hguard (guarder contextSing tag isNonNull isNonNullExpr)