on b97cd4e help sign in
rel8/src/Rel8/Schema/Spec/ConstrainDBType.hs
70 lines 1.9 kB history raw
1{-# language ConstraintKinds #-}
2{-# language DataKinds #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language QuantifiedConstraints #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10module Rel8.Schema.Spec.ConstrainDBType
11 ( ConstrainDBType
12 , dbTypeNullability
13 , dbTypeDict
14 , fromNullabilityDict
15 )
16where
18-- base
19import Data.Kind ( Constraint, Type )
20import Prelude
22-- rel8
23import Rel8.Schema.Dict ( Dict( Dict ) )
24import Rel8.Schema.Nullability
25 ( Unnullify
26 , Nullability
27 , Sql, nullabilization, toSql
28 )
29import Rel8.Schema.Spec ( Spec( Spec ) )
32type ConstrainDBType :: (Type -> Constraint) -> Spec -> Constraint
33class
34 ( forall c labels necessity a. ()
35 => (spec ~ 'Spec labels necessity a)
36 => (forall x. (constraint x => c x)) => Sql c a
37 )
38 => ConstrainDBType constraint spec
39instance
40 ( spec ~ 'Spec labels necessity a
41 , Sql constraint a
42 )
43 => ConstrainDBType constraint spec
46dbTypeNullability :: Dict (ConstrainDBType c) ('Spec l n a) -> Nullability a
47dbTypeNullability = step2 . step1
48 where
49 step1 :: Dict (ConstrainDBType c) ('Spec l n a) -> Dict (Sql c) a
50 step1 Dict = Dict
52 step2 :: Dict (Sql c) a -> Nullability a
53 step2 Dict = nullabilization
56dbTypeDict :: Dict (ConstrainDBType c) ('Spec l n a) -> Dict c (Unnullify a)
57dbTypeDict = step2 . step1
58 where
59 step1 :: Dict (ConstrainDBType c) ('Spec l n a) -> Dict (Sql c) a
60 step1 Dict = Dict
62 step2 :: Dict (Sql c) a -> Dict c (Unnullify a)
63 step2 Dict = Dict
66fromNullabilityDict :: Nullability a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l n a)
67fromNullabilityDict nullability = step2 . toSql nullability
68 where
69 step2 :: Dict (Sql c) a -> Dict (ConstrainDBType c) ('Spec l n a)
70 step2 Dict = Dict