git.iko.soy/rel8
on 53616d0 help sign in
rel8/src/Rel8/Schema/Nullability.hs
104 lines 2.8 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 , HasNullability, 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
57data Nullability a where
58 NonNullable :: IsMaybe a ~ 'False => Nullability a
59 Nullable :: IsMaybe a ~ 'False => Nullability (Maybe a)
62type HasNullability' :: Bool -> Type -> Constraint
63class
64 ( IsMaybe a ~ isMaybe
65 , IsMaybe (Unnullify a) ~ 'False
66 , Nullify' isMaybe (Unnullify a) ~ a
67 ) => HasNullability' isMaybe a
68 where
69 nullabilization' :: Nullability a
72instance IsMaybe a ~ 'False => HasNullability' 'False a where
73 nullabilization' = NonNullable
76instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where
77 nullabilization' = Nullable
80type HasNullability :: Type -> Constraint
81class HasNullability' (IsMaybe a) a => HasNullability a
82instance HasNullability' (IsMaybe a) a => HasNullability a
83instance {-# OVERLAPPING #-} HasNullability Opaque
86-- | The @Sql@ type class describes both null and not null database values,
87-- constrained by a specific class.
88--
89-- For example, if you see @Sql DBEq a@, this means any database type that
90-- supports equality, and @a@ can either be exactly an @a@, or it could also be
91-- @Maybe a@.
92type Sql :: (Type -> Constraint) -> Type -> Constraint
93class
94 ( (forall c. (forall x. (constraint x => c x)) => Sql c a)
95 , HasNullability a
96 , constraint (Unnullify a)
97 )
98 => Sql constraint a
99instance (constraint (Unnullify a), HasNullability a) => Sql constraint a
100instance {-# OVERLAPPING #-} (constraint Opaque, Sql constraint Opaque) => Sql constraint Opaque
103nullabilization :: HasNullability a => Nullability a
104nullabilization = nullabilization'