on 00a36f5 help sign in
rel8/src/Rel8/Schema/Nullability.hs
106 lines 2.9 kB history raw
1{-# language ConstraintKinds #-}
2{-# language DataKinds #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language FunctionalDependencies #-}
6{-# language GADTs #-}
7{-# language MultiParamTypeClasses #-}
8{-# language QuantifiedConstraints #-}
9{-# language StandaloneKindSignatures #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
12{-# language UndecidableSuperClasses #-}
14module Rel8.Schema.Nullability
15 ( IsMaybe, Nullify, Unnullify
16 , Nullability( Nullable, NonNullable )
17 , Sql
18 , Nullabilizes, nullabilization
19 )
20where
22-- base
23import Data.Kind ( Constraint, Type )
24import Prelude
26-- rel8
27import Rel8.Opaque ( Opaque )
30type IsMaybe :: Type -> Bool
31type family IsMaybe a where
32 IsMaybe (Maybe _) = 'True
33 IsMaybe _ = 'False
36type Unnullify' :: Bool -> Type -> Type
37type family Unnullify' isMaybe ma where
38 Unnullify' 'False a = a
39 Unnullify' 'True (Maybe a) = a
42type Unnullify :: Type -> Type
43type Unnullify a = Unnullify' (IsMaybe a) a
46type Nullify' :: Bool -> Type -> Type
47type family Nullify' isMaybe a where
48 Nullify' 'False a = a
49 Nullify' 'True a = Maybe a
52type Nullify :: Type -> Type
53type Nullify a = Maybe (Unnullify a)
56type Nullability :: Type -> Type -> Type
57data Nullability a ma where
58 NonNullable :: IsMaybe a ~ 'False => Nullability a a
59 Nullable :: IsMaybe a ~ 'False => Nullability a (Maybe a)
62type Nullabilizes' :: Bool -> Type -> Type -> Constraint
63class
64 ( IsMaybe ma ~ isMaybe
65 , IsMaybe a ~ 'False
66 , Unnullify ma ~ a
67 , Nullify' isMaybe a ~ ma
68 ) => Nullabilizes' isMaybe a ma | isMaybe ma -> a, isMaybe a -> ma
69 where
70 nullabilization' :: Nullability a ma
73instance IsMaybe a ~ 'False => Nullabilizes' 'False a a where
74 nullabilization' = NonNullable
77instance IsMaybe a ~ 'False => Nullabilizes' 'True a (Maybe a) where
78 nullabilization' = Nullable
81type Nullabilizes :: Type -> Type -> Constraint
82class Nullabilizes' (IsMaybe ma) a ma => Nullabilizes a ma
83instance Nullabilizes' (IsMaybe ma) a ma => Nullabilizes a ma
84instance {-# OVERLAPPING #-} Nullabilizes Opaque Opaque
87-- | The @Sql@ type class describes both null and not null database values,
88-- constrained by a specific class.
89--
90-- For example, if you see @Sql DBEq a@, this means any database type that
91-- supports equality, and @a@ can either be exactly an @a@, or it could also be
92-- @Maybe a@.
93type Sql :: (Type -> Constraint) -> Type -> Constraint
94class
95 ( (forall c. (forall x. (constraint x => c x)) => Sql c a)
96 , Nullabilizes (Unnullify a) a
97 , constraint (Unnullify a)
98 )
99 => Sql constraint a
100instance (constraint db, Nullabilizes db a) => Sql constraint a
101instance {-# OVERLAPPING #-} (constraint Opaque, Sql constraint Opaque) => Sql constraint Opaque
102-- instance {-# OVERLAPPING #-} Sql OpaqueC Opaque => Sql OpaqueC Opaque
105nullabilization :: forall a db. Nullabilizes db a => Nullability db a
106nullabilization = nullabilization'