git.iko.soy/rel8
on 35c6127 help sign in
rel8/src/Rel8/Table/Nullify.hs
184 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.Nullify
32 ( Nullifiability( NAggregate, NExpr )
33 , NonNullifiability
34 , Nullifiable, nullifiability
35 , nullifiableOrNot, absurd
36 , guarder
37 , nullifier
38 , unnullifier
39 )
40import Rel8.Schema.Dict ( Dict( Dict ) )
41import Rel8.Schema.HTable ( HTable )
42import Rel8.Schema.HTable.Nullify
43 ( HNullify, hnulls, hnullify, hunnullify
44 , hguard
45 , hproject
46 )
47import qualified Rel8.Schema.Kind as K
48import qualified Rel8.Schema.Result as R
49import Rel8.Table
50 ( Table, Columns, Context, toColumns, fromColumns
51 , FromExprs, fromResult, toResult
52 , Transpose
53 )
54import Rel8.Table.Eq ( EqTable, eqTable )
55import Rel8.Table.Ord ( OrdTable, ordTable )
56import Rel8.Table.Projection ( Projectable, apply, project )
58-- semigroupoids
59import Data.Functor.Apply ( Apply, (<.>), liftF2 )
60import Data.Functor.Bind ( Bind, (>>-) )
61import Data.Functor.Extend ( Extend, duplicated )
64type Nullify :: K.Context -> Type -> Type
65data Nullify context a
66 = Table (Nullifiability context) a
67 | Fields (NonNullifiability context) (HNullify (Columns a) (Context a))
70instance Projectable (Nullify context) where
71 project f = \case
72 Table nullifiable a -> Table nullifiable (fromColumns (apply f (toColumns a)))
73 Fields nonNullifiable a -> Fields nonNullifiable (hproject (apply f) a)
76instance Nullifiable context => Functor (Nullify context) where
77 fmap f = \case
78 Table nullifiable a -> Table nullifiable (f a)
79 Fields notNullifiable _ -> absurd nullifiability notNullifiable
82instance Nullifiable context => Foldable (Nullify context) where
83 foldMap f = \case
84 Table _ a -> f a
85 Fields notNullifiable _ -> absurd nullifiability notNullifiable
88instance Nullifiable context => Traversable (Nullify context) where
89 traverse f = \case
90 Table nullifiable a -> Table nullifiable <$> f a
91 Fields notNullifiable _ -> absurd nullifiability notNullifiable
94instance Nullifiable context => Apply (Nullify context) where
95 liftF2 f = \case
96 Table nullifiable a -> \case
97 Table _ b -> Table nullifiable (f a b)
98 Fields notNullifiable _ -> absurd nullifiable notNullifiable
99 Fields notNullifiable _ -> absurd nullifiability notNullifiable
102instance Nullifiable context => Applicative (Nullify context) where
103 pure = Table nullifiability
104 liftA2 = liftF2
107instance Nullifiable context => Bind (Nullify context) where
108 Table _ a >>- f = f a
109 Fields notNullifiable _ >>- _ = absurd nullifiability notNullifiable
112instance Nullifiable context => Monad (Nullify context) where
113 (>>=) = (>>-)
116instance Nullifiable context => Extend (Nullify context) where
117 duplicated = \case
118 Table nullifiable a -> Table nullifiable (Table nullifiable a)
119 Fields notNullifiable _ -> absurd nullifiability notNullifiable
122instance Nullifiable context => Comonad (Nullify context) where
123 extract = \case
124 Table _ a -> a
125 Fields notNullifiable _ -> absurd nullifiability notNullifiable
126 duplicate = duplicated
129instance Nullifiable context => ComonadApply (Nullify context) where
130 (<@>) = (<.>)
133instance (Table context a, Reifiable context, context ~ context') =>
134 Table context' (Nullify context a)
135 where
136 type Columns (Nullify context a) = HNullify (Columns a)
137 type Context (Nullify context a) = Context a
138 type FromExprs (Nullify context a) = Maybe (FromExprs a)
139 type Transpose to (Nullify context a) = Nullify to (Transpose to a)
141 fromColumns = case nullifiableOrNot contextSing of
142 Left notNullifiable -> Fields notNullifiable
143 Right nullifiable ->
144 Table nullifiable .
145 fromColumns .
146 runIdentity .
147 hunnullify (\spec -> pure . unnullifier nullifiable spec)
149 toColumns = \case
150 Table nullifiable a -> hnullify (nullifier nullifiable) (toColumns a)
151 Fields _ a -> a
153 fromResult = fmap (fromResult @_ @a) . hunnullify R.unnullifier
155 toResult =
156 maybe (hnulls (const R.null)) (hnullify R.nullifier) .
157 fmap (toResult @_ @a)
160instance (EqTable a, context ~ Expr) => EqTable (Nullify context a) where
161 eqTable = hnullify (\_ Dict -> Dict) (eqTable @a)
164instance (OrdTable a, context ~ Expr) => OrdTable (Nullify context a) where
165 ordTable = hnullify (\_ Dict -> Dict) (ordTable @a)
168aggregateNullify :: ()
169 => (exprs -> aggregates)
170 -> Nullify Expr exprs
171 -> Nullify Aggregate aggregates
172aggregateNullify f = \case
173 Table _ a -> Table NAggregate (f a)
174 Fields notNullifiable _ -> absurd NExpr notNullifiable
177guard :: (Reifiable context, HTable t)
178 => context tag
179 -> (tag -> Bool)
180 -> (Expr tag -> Expr Bool)
181 -> HNullify t context
182 -> HNullify t context
183guard tag isNonNull isNonNullExpr =
184 hguard (guarder contextSing tag isNonNull isNonNullExpr)