git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Table/Nullify.hs
211 lines 6.1 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language LambdaCase #-}
5{-# language MultiParamTypeClasses #-}
6{-# language NamedFieldPuns #-}
7{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
13module Rel8.Table.Nullify
14 ( Nullify
15 , aggregateNullify
16 , guard
17 , isNull
18 )
19where
21-- base
22import Control.Applicative ( liftA2 )
23import Data.Functor.Const ( Const( Const ), getConst )
24import Data.Functor.Identity ( runIdentity )
25import Data.Kind ( Type )
26import Prelude
28-- comonad
29import Control.Comonad ( Comonad, duplicate, extract, ComonadApply, (<@>) )
31-- rel8
32import Rel8.Aggregate ( Aggregate )
33import Rel8.Expr ( Expr )
34import Rel8.Expr.Bool ( (||.), false )
35import qualified Rel8.Expr.Null as Expr
36import Rel8.Kind.Context ( Reifiable, contextSing )
37import Rel8.Schema.Context.Nullify
38 ( Nullifiability( NAggregate, NExpr )
39 , NonNullifiability
40 , Nullifiable, nullifiability
41 , nullifiableOrNot, absurd
42 , guarder
43 , nullifier
44 , unnullifier
45 )
46import Rel8.Schema.Dict ( Dict( Dict ) )
47import Rel8.Schema.HTable ( HTable )
48import Rel8.Schema.HTable.Nullify
49 ( HNullify, hnulls, hnullify, hunnullify
50 , hguard
51 , hproject
52 )
53import qualified Rel8.Schema.Kind as K
54import Rel8.Schema.Null ( Nullity( NotNull, Null ) )
55import qualified Rel8.Schema.Result as R
56import Rel8.Table
57 ( Table, Columns, Context, toColumns, fromColumns
58 , FromExprs, fromResult, toResult
59 , Transpose
60 )
61import Rel8.Schema.Spec ( Spec( Spec, nullity ) )
62import Rel8.Table.Eq ( EqTable, eqTable )
63import Rel8.Table.Ord ( OrdTable, ordTable )
64import Rel8.Table.Projection ( Projectable, apply, project )
66-- semigroupoids
67import Data.Functor.Apply ( Apply, (<.>), liftF2 )
68import Data.Functor.Bind ( Bind, (>>-) )
69import Data.Functor.Extend ( Extend, duplicated )
72type Nullify :: K.Context -> Type -> Type
73data Nullify context a
74 = Table (Nullifiability context) a
75 | Fields (NonNullifiability context) (HNullify (Columns a) (Context a))
78instance Projectable (Nullify context) where
79 project f = \case
80 Table nullifiable a -> Table nullifiable (fromColumns (apply f (toColumns a)))
81 Fields nonNullifiable a -> Fields nonNullifiable (hproject (apply f) a)
84instance Nullifiable context => Functor (Nullify context) where
85 fmap f = \case
86 Table nullifiable a -> Table nullifiable (f a)
87 Fields notNullifiable _ -> absurd nullifiability notNullifiable
90instance Nullifiable context => Foldable (Nullify context) where
91 foldMap f = \case
92 Table _ a -> f a
93 Fields notNullifiable _ -> absurd nullifiability notNullifiable
96instance Nullifiable context => Traversable (Nullify context) where
97 traverse f = \case
98 Table nullifiable a -> Table nullifiable <$> f a
99 Fields notNullifiable _ -> absurd nullifiability notNullifiable
102instance Nullifiable context => Apply (Nullify context) where
103 liftF2 f = \case
104 Table nullifiable a -> \case
105 Table _ b -> Table nullifiable (f a b)
106 Fields notNullifiable _ -> absurd nullifiable notNullifiable
107 Fields notNullifiable _ -> absurd nullifiability notNullifiable
110instance Nullifiable context => Applicative (Nullify context) where
111 pure = Table nullifiability
112 liftA2 = liftF2
115instance Nullifiable context => Bind (Nullify context) where
116 Table _ a >>- f = f a
117 Fields notNullifiable _ >>- _ = absurd nullifiability notNullifiable
120instance Nullifiable context => Monad (Nullify context) where
121 (>>=) = (>>-)
124instance Nullifiable context => Extend (Nullify context) where
125 duplicated = \case
126 Table nullifiable a -> Table nullifiable (Table nullifiable a)
127 Fields notNullifiable _ -> absurd nullifiability notNullifiable
130instance Nullifiable context => Comonad (Nullify context) where
131 extract = \case
132 Table _ a -> a
133 Fields notNullifiable _ -> absurd nullifiability notNullifiable
134 duplicate = duplicated
137instance Nullifiable context => ComonadApply (Nullify context) where
138 (<@>) = (<.>)
141instance (Table context a, Reifiable context, context ~ context') =>
142 Table context' (Nullify context a)
143 where
144 type Columns (Nullify context a) = HNullify (Columns a)
145 type Context (Nullify context a) = Context a
146 type FromExprs (Nullify context a) = Maybe (FromExprs a)
147 type Transpose to (Nullify context a) = Nullify to (Transpose to a)
149 fromColumns = case nullifiableOrNot contextSing of
150 Left notNullifiable -> Fields notNullifiable
151 Right nullifiable ->
152 Table nullifiable .
153 fromColumns .
154 runIdentity .
155 hunnullify (\spec -> pure . unnullifier nullifiable spec)
157 toColumns = \case
158 Table nullifiable a -> hnullify (nullifier nullifiable) (toColumns a)
159 Fields _ a -> a
161 fromResult = fmap (fromResult @_ @a) . hunnullify R.unnullifier
163 toResult =
164 maybe (hnulls (const R.null)) (hnullify R.nullifier) .
165 fmap (toResult @_ @a)
168instance (EqTable a, context ~ Expr) => EqTable (Nullify context a) where
169 eqTable = hnullify (\_ Dict -> Dict) (eqTable @a)
172instance (OrdTable a, context ~ Expr) => OrdTable (Nullify context a) where
173 ordTable = hnullify (\_ Dict -> Dict) (ordTable @a)
176aggregateNullify :: ()
177 => (exprs -> aggregates)
178 -> Nullify Expr exprs
179 -> Nullify Aggregate aggregates
180aggregateNullify f = \case
181 Table _ a -> Table NAggregate (f a)
182 Fields notNullifiable _ -> absurd NExpr notNullifiable
185guard :: (Reifiable context, HTable t)
186 => context tag
187 -> (tag -> Bool)
188 -> (Expr tag -> Expr Bool)
189 -> HNullify t context
190 -> HNullify t context
191guard tag isNonNull isNonNullExpr =
192 hguard (guarder contextSing tag isNonNull isNonNullExpr)
195isNull :: forall a. Table Expr a => Nullify Expr a -> Expr Bool
196isNull =
197 maybe false getAny .
198 getConst .
199 hunnullify (\Spec {nullity} a -> Const $ case nullity of
200 NotNull -> Just $ Any $ Expr.isNull a
201 Null -> Nothing) .
202 toColumns
205newtype Any = Any
206 { getAny :: Expr Bool
207 }
210instance Semigroup Any where
211 Any a <> Any b = Any (a ||. b)