git.iko.soy/rel8
on f47423e help sign in
rel8/src/Rel8/Table/Nullify.hs
173 lines 5.1 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 ( HNullify, hnulls, hnullify, hunnullify, hguard )
43import qualified Rel8.Schema.Kind as K
44import qualified Rel8.Schema.Result as R
45import Rel8.Table
46 ( Table, Columns, Context, toColumns, fromColumns
47 , FromExprs, fromResult, toResult
48 , Transpose
49 )
50import Rel8.Table.Eq ( EqTable, eqTable )
51import Rel8.Table.Ord ( OrdTable, ordTable )
53-- semigroupoids
54import Data.Functor.Apply ( Apply, (<.>), liftF2 )
55import Data.Functor.Bind ( Bind, (>>-) )
56import Data.Functor.Extend ( Extend, duplicated )
59type Nullify :: K.Context -> Type -> Type
60data Nullify context a
61 = Table (Nullifiability context) a
62 | Fields (NonNullifiability context) (HNullify (Columns a) (Context a))
65instance Nullifiable context => Functor (Nullify context) where
66 fmap f = \case
67 Table nullifiable a -> Table nullifiable (f a)
68 Fields notNullifiable _ -> absurd nullifiability notNullifiable
71instance Nullifiable context => Foldable (Nullify context) where
72 foldMap f = \case
73 Table _ a -> f a
74 Fields notNullifiable _ -> absurd nullifiability notNullifiable
77instance Nullifiable context => Traversable (Nullify context) where
78 traverse f = \case
79 Table nullifiable a -> Table nullifiable <$> f a
80 Fields notNullifiable _ -> absurd nullifiability notNullifiable
83instance Nullifiable context => Apply (Nullify context) where
84 liftF2 f = \case
85 Table nullifiable a -> \case
86 Table _ b -> Table nullifiable (f a b)
87 Fields notNullifiable _ -> absurd nullifiable notNullifiable
88 Fields notNullifiable _ -> absurd nullifiability notNullifiable
91instance Nullifiable context => Applicative (Nullify context) where
92 pure = Table nullifiability
93 liftA2 = liftF2
96instance Nullifiable context => Bind (Nullify context) where
97 Table _ a >>- f = f a
98 Fields notNullifiable _ >>- _ = absurd nullifiability notNullifiable
101instance Nullifiable context => Monad (Nullify context) where
102 (>>=) = (>>-)
105instance Nullifiable context => Extend (Nullify context) where
106 duplicated = \case
107 Table nullifiable a -> Table nullifiable (Table nullifiable a)
108 Fields notNullifiable _ -> absurd nullifiability notNullifiable
111instance Nullifiable context => Comonad (Nullify context) where
112 extract = \case
113 Table _ a -> a
114 Fields notNullifiable _ -> absurd nullifiability notNullifiable
115 duplicate = duplicated
118instance Nullifiable context => ComonadApply (Nullify context) where
119 (<@>) = (<.>)
122instance (Table context a, Reifiable context, context ~ context') =>
123 Table context' (Nullify context a)
124 where
125 type Columns (Nullify context a) = HNullify (Columns a)
126 type Context (Nullify context a) = Context a
127 type FromExprs (Nullify context a) = Maybe (FromExprs a)
128 type Transpose to (Nullify context a) = Nullify to (Transpose to a)
130 fromColumns = case nullifiableOrNot contextSing of
131 Left notNullifiable -> Fields notNullifiable
132 Right nullifiable ->
133 Table nullifiable .
134 fromColumns .
135 runIdentity .
136 hunnullify (\spec -> pure . unnullifier nullifiable spec)
138 toColumns = \case
139 Table nullifiable a -> hnullify (nullifier nullifiable) (toColumns a)
140 Fields _ a -> a
142 fromResult = fmap (fromResult @_ @a) . hunnullify R.unnullifier
144 toResult =
145 maybe (hnulls (const R.null)) (hnullify R.nullifier) .
146 fmap (toResult @_ @a)
149instance (EqTable a, context ~ Expr) => EqTable (Nullify context a) where
150 eqTable = hnullify (\_ Dict -> Dict) (eqTable @a)
153instance (OrdTable a, context ~ Expr) => OrdTable (Nullify context a) where
154 ordTable = hnullify (\_ Dict -> Dict) (ordTable @a)
157aggregateNullify :: ()
158 => (exprs -> aggregates)
159 -> Nullify Expr exprs
160 -> Nullify Aggregate aggregates
161aggregateNullify f = \case
162 Table _ a -> Table NAggregate (f a)
163 Fields notNullifiable _ -> absurd NExpr notNullifiable
166guard :: (Reifiable context, HTable t)
167 => context tag
168 -> (tag -> Bool)
169 -> (Expr tag -> Expr Bool)
170 -> HNullify t context
171 -> HNullify t context
172guard tag isNonNull isNonNullExpr =
173 hguard (guarder contextSing tag isNonNull isNonNullExpr)