git.iko.soy/rel8
on 11bcbbb help sign in
rel8/src/Rel8/Schema/Nullability.hs
118 lines 3.1 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 ( Nullify, Unnullify
16 , NotNull
17 , Homonullable
18 , Nullability( Nullable, NonNullable )
19 , HasNullability, nullabilization
20 , Sql
21 )
22where
24-- base
25import Data.Kind ( Constraint, Type )
26import Prelude
28-- rel8
29import Rel8.Opaque ( Opaque )
32type IsMaybe :: Type -> Bool
33type family IsMaybe a where
34 IsMaybe (Maybe _) = 'True
35 IsMaybe _ = 'False
38type Unnullify' :: Bool -> Type -> Type
39type family Unnullify' isMaybe ma where
40 Unnullify' 'False a = a
41 Unnullify' 'True (Maybe a) = a
44type Unnullify :: Type -> Type
45type Unnullify a = Unnullify' (IsMaybe a) a
48type Nullify' :: Bool -> Type -> Type
49type family Nullify' isMaybe a where
50 Nullify' 'False a = a
51 Nullify' 'True a = Maybe a
54type Nullify :: Type -> Type
55type Nullify a = Maybe (Unnullify a)
58type NotNull :: Type -> Constraint
59class (HasNullability a, IsMaybe a ~ 'False) => NotNull a
60instance (HasNullability a, IsMaybe a ~ 'False) => NotNull a
61instance {-# OVERLAPPING #-} NotNull Opaque
64type Homonullable :: Type -> Type -> Constraint
65class IsMaybe a ~ IsMaybe b => Homonullable a b
66instance IsMaybe a ~ IsMaybe b => Homonullable a b
67instance {-# OVERLAPPING #-} Homonullable Opaque Opaque
70type Nullability :: Type -> Type
71data Nullability a where
72 NonNullable :: NotNull a => Nullability a
73 Nullable :: NotNull a => Nullability (Maybe a)
76type HasNullability' :: Bool -> Type -> Constraint
77class
78 ( IsMaybe a ~ isMaybe
79 , IsMaybe (Unnullify a) ~ 'False
80 , Nullify' isMaybe (Unnullify a) ~ a
81 ) => HasNullability' isMaybe a
82 where
83 nullabilization' :: Nullability a
86instance IsMaybe a ~ 'False => HasNullability' 'False a where
87 nullabilization' = NonNullable
90instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where
91 nullabilization' = Nullable
94type HasNullability :: Type -> Constraint
95class HasNullability' (IsMaybe a) a => HasNullability a
96instance HasNullability' (IsMaybe a) a => HasNullability a
97instance {-# OVERLAPPING #-} HasNullability Opaque
100nullabilization :: HasNullability a => Nullability a
101nullabilization = nullabilization'
104-- | The @Sql@ type class describes both null and not null database values,
105-- constrained by a specific class.
106--
107-- For example, if you see @Sql DBEq a@, this means any database type that
108-- supports equality, and @a@ can either be exactly an @a@, or it could also be
109-- @Maybe a@.
110type Sql :: (Type -> Constraint) -> Type -> Constraint
111class
112 ( (forall c. (forall x. (constraint x => c x)) => Sql c a)
113 , HasNullability a
114 , constraint (Unnullify a)
115 )
116 => Sql constraint a
117instance (constraint (Unnullify a), HasNullability a) => Sql constraint a
118instance {-# OVERLAPPING #-} (c Opaque, Sql c Opaque) => Sql c Opaque