git.iko.soy/rel8
on master help sign in
Slightly less constraint fuckery is needed now that we don't use Opaque
commit4e90af3265c1dd9aaf1a4fa9840d2176d0bc7352 authorShane O'Brien <shane.obrien@circuithub.com> dateThu 8 Apr 2021, 11:53 (6 years ago) parentf1e287e
3 files changed+6−36
compare with master
unifiedsplit
src/Rel8/Schema/Null.hs+1−22 src/Rel8/Schema/Spec/ConstrainDBType.hs+3−5 src/Rel8/Table/Tag.hs+2−9
src/Rel8/Schema/Null.hs+1−22
@@ -16,7 +16,7 @@ module Rel8.Schema.Null
1616 , Homonullable
1717 , Nullity( Null, NotNull )
1818 , Nullable, nullable
19− , Sql, fromSql, mapSql, toSql
19+ , Sql
2020 )
2121where
2222
@@ -24,9 +24,6 @@ where
2424import Data.Kind ( Constraint, Type )
2525import Prelude
2626
27−-- rel8
28−import Rel8.Schema.Dict ( Dict( Dict ) )
29−
3027
3128type IsMaybe :: Type -> Bool
3229type family IsMaybe a where
@@ -111,21 +108,3 @@ nullable = nullable'
111108type Sql :: (Type -> Constraint) -> Type -> Constraint
112109class (constraint (Unnullify a), Nullable a) => Sql constraint a
113110instance (constraint (Unnullify a), Nullable a) => Sql constraint a
114−
115−
116−fromSql :: Dict (Sql constraint) a -> (Nullity a, Dict constraint (Unnullify a))
117−fromSql Dict = (nullable, Dict)
118−{-# INLINABLE fromSql #-}
119−
120−
121−mapSql :: ()
122− => (forall x. Dict constraint x -> Dict constraint' x)
123− -> Dict (Sql constraint) a -> Dict (Sql constraint') a
124−mapSql f dict = case fromSql dict of
125− (nullity, dict') -> toSql nullity (f dict')
126−
127−
128−toSql :: Nullity a -> Dict constraint (Unnullify a) -> Dict (Sql constraint) a
129−toSql NotNull Dict = Dict
130−toSql Null Dict = Dict
131−{-# INLINABLE toSql #-}
src/Rel8/Schema/Spec/ConstrainDBType.hs+3−5
@@ -21,7 +21,7 @@ import Prelude
2121
2222-- rel8
2323import Rel8.Schema.Dict ( Dict( Dict ) )
24−import Rel8.Schema.Null ( Unnullify, Nullity, Sql, nullable, toSql )
24+import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ), Sql, nullable )
2525import Rel8.Schema.Spec ( Spec( Spec ) )
2626
2727
@@ -60,7 +60,5 @@ dbTypeDict = step2 . step1
6060
6161
6262fromNullityDict :: Nullity a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l n a)
63−fromNullityDict nullity = step2 . toSql nullity
64− where
65− step2 :: Dict (Sql c) a -> Dict (ConstrainDBType c) ('Spec l n a)
66− step2 Dict = Dict
63+fromNullityDict Null Dict = Dict
64+fromNullityDict NotNull Dict = Dict
src/Rel8/Table/Tag.hs+2−9
@@ -29,11 +29,9 @@ import Prelude
2929import Rel8.Aggregate ( Aggregate, Aggregator, foldInputs )
3030import Rel8.Expr ( Expr )
3131import Rel8.Expr.Opaleye ( fromPrimExpr )
32−import Rel8.Schema.Dict ( Dict( Dict ) )
3332import Rel8.Schema.Name ( Name( Name ) )
34−import Rel8.Schema.Null ( Sql, mapSql )
33+import Rel8.Schema.Null ( Sql )
3534import Rel8.Type.Monoid ( DBMonoid )
36−import Rel8.Type.Semigroup ( DBSemigroup )
3735
3836
3937type Tag :: Symbol -> Type -> Type
@@ -54,8 +52,7 @@ instance Sql DBMonoid a => Taggable a where
5452 tappend :: forall label. KnownSymbol label
5553 => Tag label a -> Tag label a -> Tag label a
5654 tappend a b = Tag
57− { expr = case mapSql dbSemigroupFromDBMonoid (Dict @_ @a) of
58− Dict -> expr a <> expr b
55+ { expr = expr a <> expr b
5956 , aggregator = aggregator a <|> aggregator b
6057 , name = case (name a, symbolVal (Proxy @label)) of
6158 (Name x, y)
@@ -98,7 +95,3 @@ fromExpr expr = (tempty @a @label) {expr}
9895
9996fromName :: forall a label. Taggable a => Name a -> Tag label a
10097fromName name = (tempty @a @"") {name}
101−
102−
103−dbSemigroupFromDBMonoid :: Dict DBMonoid a -> Dict DBSemigroup a
104−dbSemigroupFromDBMonoid Dict = Dict