git.iko.soy/rel8
on 11bcbbb help sign in
rel8/src/Rel8/Schema/Context/Nullify.hs
80 lines 2.3 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeFamilies #-}
8module Rel8.Schema.Context.Nullify
9 ( Nullifiable( encodeTag, decodeTag, nullifier, unnullifier )
10 , NullifiableEq
11 , unnull, runTag
12 )
13where
15-- base
16import Data.Kind ( Constraint )
17import Prelude hiding ( null )
19-- opaleye
20import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
22-- rel8
23import {-# SOURCE #-} Rel8.Expr ( Expr )
24import Rel8.Expr.Bool ( boolExpr )
25import Rel8.Expr.Null ( nullify, unsafeUnnullify )
26import Rel8.Expr.Opaleye ( fromPrimExpr )
27import Rel8.Kind.Labels ( KnownLabels )
28import Rel8.Kind.Necessity ( Necessity( Required ) )
29import Rel8.Schema.Context ( Interpretation, Col(..) )
30import qualified Rel8.Schema.Kind as K
31import Rel8.Schema.Nullability
32 ( Nullify
33 , Nullability( Nullable, NonNullable )
34 , Sql
35 )
36import Rel8.Schema.Spec ( Spec( Spec ), SSpec )
37import Rel8.Type.Eq ( DBEq )
38import Rel8.Type.Monoid ( DBMonoid )
41type Nullifiable :: K.Context -> Constraint
42class Interpretation context => Nullifiable context where
43 encodeTag :: (Sql DBEq a, KnownLabels labels)
44 => Expr a
45 -> Col context ('Spec labels 'Required a)
47 decodeTag :: Sql DBMonoid a
48 => Col context ('Spec labels 'Required a)
49 -> Expr a
51 nullifier :: ()
52 => Expr Bool
53 -> SSpec ('Spec labels necessity a)
54 -> Col context ('Spec labels necessity a)
55 -> Col context ('Spec labels necessity (Nullify a))
57 unnullifier :: ()
58 => Expr Bool
59 -> SSpec ('Spec labels necessity a)
60 -> Col context ('Spec labels necessity (Nullify a))
61 -> Col context ('Spec labels necessity a)
64type NullifiableEq :: K.Context -> K.Context -> Constraint
65class (a ~ b, Nullifiable b) => NullifiableEq a b
66instance (a ~ b, Nullifiable b) => NullifiableEq a b
69runTag :: Nullability a -> Expr Bool -> Expr a -> Expr (Nullify a)
70runTag nullability tag a = case nullability of
71 Nullable -> boolExpr null a tag
72 NonNullable -> boolExpr null (nullify a) tag
73 where
74 null = fromPrimExpr $ Opaleye.ConstExpr Opaleye.NullLit
77unnull :: Nullability a -> Expr (Nullify a) -> Expr a
78unnull nullability a = case nullability of
79 Nullable -> a
80 NonNullable -> unsafeUnnullify a