git.iko.soy/squeal
on dev help sign in
get example working
commitd73413e8de2099f261cc3d4b0e2b343b99a08404 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 8 Dec 2017, 13:08 (9 years ago) parente50f0a0
4 files changed+44−33
compare with dev
unifiedsplit
squeal-postgresql/exe/Example.hs+17−17 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+4−4 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+3−3 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+20−9
squeal-postgresql/exe/Example.hs+17−17
@@ -4,6 +4,7 @@
44 , FlexibleContexts
55 , OverloadedLabels
66 , OverloadedStrings
7+ , PolyKinds
78 , TypeApplications
89 , TypeOperators
910#-}
@@ -23,14 +24,15 @@ import qualified Generics.SOP as SOP
2324import qualified GHC.Generics as GHC
2425
2526type Schema =
26− '[ "users" :::
27− '[ "id" ::: ('[ 'Default, 'Unique] :=> 'NotNull 'PGint4)
28− , "name" ::: ('[] :=> 'NotNull 'PGtext)
27+ '[ "users" ::: '[] :=>
28+ '[ "id" ::: AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint4
29+ , "name" ::: '[] :=> 'NotNull 'PGtext
2930 ]
30− , "emails" :::
31− '[ "id" ::: ('[ 'Default, 'Unique] :=> 'NotNull 'PGint4)
32− , "user_id" ::: ('[] :=> 'NotNull 'PGint4)
33− , "email" ::: ('[] :=> 'Null 'PGtext)
31+ , "emails" ::: AsSet
32+ '[ 'ForeignKey '["user_id"] "users" '["id"] ] :=>
33+ '[ "id" ::: AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint4
34+ , "user_id" ::: '[] :=> 'NotNull 'PGint4
35+ , "email" ::: '[] :=> 'Null 'PGtext
3436 ]
3537 ]
3638
@@ -38,29 +40,27 @@ setup :: Definition '[] Schema
3840setup =
3941 createTable #users
4042 ( serial `As` #id :*
41− (text & notNull) `As` #name :* Nil )
42− [ primaryKey (Column #id :* Nil) ]
43+ (text & notNull) `As` #name :* Nil ) Nil
4344 >>>
4445 createTable #emails
4546 ( serial `As` #id :*
4647 (int & notNull) `As` #user_id :*
4748 text `As` #email :* Nil )
48− [ primaryKey (Column #id :* Nil)
49− , foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)
50− OnDeleteCascade OnUpdateCascade ]
49+ ( foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)
50+ OnDeleteCascade OnUpdateCascade :* Nil )
5151
5252teardown :: Definition Schema '[]
5353teardown = dropTable #emails >>> dropTable #users
5454
5555insertUser :: Manipulation Schema
56− '[ '[] ::=> 'NotNull 'PGtext]
57− '[ "fromOnly" ::: ('[] ::=> 'NotNull 'PGint4) ]
56+ '[ '[] :=> 'NotNull 'PGtext]
57+ '[ "fromOnly" ::: ('[] :=> 'NotNull 'PGint4) ]
5858insertUser = insertInto #users
5959 ( Values (def `As` #id :* param @1 `As` #name :* Nil) [] )
6060 OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))
6161
6262insertEmail :: Manipulation Schema
63− '[ '[] ::=> 'NotNull 'PGint4, '[] ::=> 'Null 'PGtext] '[]
63+ '[ '[] :=> 'NotNull 'PGint4, '[] :=> 'Null 'PGtext] '[]
6464insertEmail = insertInto #emails ( Values
6565 ( def `As` #id :*
6666 param @1 `As` #user_id :*
@@ -68,8 +68,8 @@ insertEmail = insertInto #emails ( Values
6868 OnConflictDoNothing (Returning Nil)
6969
7070getUsers :: Query Schema '[]
71− '[ "userName" ::: ('[] ::=> 'NotNull 'PGtext)
72− , "userEmail" ::: ('[] ::=> 'Null 'PGtext) ]
71+ '[ "userName" ::: ('[] :=> 'NotNull 'PGtext)
72+ , "userEmail" ::: ('[] :=> 'Null 'PGtext) ]
7373getUsers = select
7474 (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)
7575 ( from (Table (#users `As` #u)
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+4−4
@@ -180,7 +180,7 @@ unique
180180 :: SOP.SListI subcolumns
181181 => NP (Column columns) subcolumns
182182 -- ^ unique column or group of columns
183− -> TableConstraint schema columns ( 'Uniques subcolumns)
183+ -> TableConstraint schema columns ( 'Uniques (Aliases subcolumns))
184184unique columns = UnsafeTableConstraint $
185185 "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)
186186
@@ -197,10 +197,10 @@ unique columns = UnsafeTableConstraint $
197197-- :}
198198-- "CREATE TABLE tab (id serial, name text NOT NULL, PRIMARY KEY (id));"
199199primaryKey
200− :: (SOP.SListI subcolumns, AllNotNull subcolumns)
200+ :: (SOP.SListI subcolumns, NotAllNull subcolumns)
201201 => NP (Column columns) subcolumns
202202 -- ^ identifying column or group of columns
203− -> TableConstraint schema columns ('Uniques subcolumns)
203+ -> TableConstraint schema columns ('Uniques (Aliases subcolumns))
204204primaryKey columns = UnsafeTableConstraint $
205205 "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
206206
@@ -254,7 +254,7 @@ foreignKey
254254 -> OnUpdateClause
255255 -- ^ what to do when reference is updated
256256 -> TableConstraint schema columns
257− ('ForeignKey subcolumns tab refsubcolumns)
257+ ('ForeignKey (Aliases subcolumns) tab (Aliases refsubcolumns))
258258foreignKey columns reftable refcolumns onDelete onUpdate =
259259 UnsafeTableConstraint $
260260 "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+3−3
@@ -1046,19 +1046,19 @@ doublePrecision = UnsafeTypeExpression "double precision"
10461046-- | not a true type, but merely a notational convenience for creating
10471047-- unique identifier columns with type `'PGint2`
10481048serial2, smallserial
1049− :: TypeExpression ( '[ 'Default, 'Unique] :=> 'NotNull 'PGint2)
1049+ :: TypeExpression ( AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint2)
10501050serial2 = UnsafeTypeExpression "serial2"
10511051smallserial = UnsafeTypeExpression "smallserial"
10521052-- | not a true type, but merely a notational convenience for creating
10531053-- unique identifier columns with type `'PGint4`
10541054serial4, serial
1055− :: TypeExpression ( '[ 'Default, 'Unique] :=> 'NotNull 'PGint4)
1055+ :: TypeExpression ( AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint4)
10561056serial4 = UnsafeTypeExpression "serial4"
10571057serial = UnsafeTypeExpression "serial"
10581058-- | not a true type, but merely a notational convenience for creating
10591059-- unique identifier columns with type `'PGint8`
10601060serial8, bigserial
1061− :: TypeExpression ( '[ 'Default, 'Unique] :=> 'NotNull 'PGint8)
1061+ :: TypeExpression ( AsSet '[ 'Default, 'Unique] :=> 'NotNull 'PGint8)
10621062serial8 = UnsafeTypeExpression "serial8"
10631063bigserial = UnsafeTypeExpression "bigserial"
10641064-- | variable-length character string
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+20−9
@@ -82,6 +82,8 @@ module Squeal.PostgreSQL.Schema
8282 , AddConstraint
8383 , DropConstraint
8484 , TableConstraint' (..)
85+ , AsSet
86+ , Aliases
8587 ) where
8688
8789import Control.DeepSeq
@@ -184,6 +186,7 @@ type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8]
184186-- an alias and some type, usually a column alias and a `ColumnType` or
185187-- a table alias and a `ColumnsType`.
186188type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)
189+infixr 6 :::
187190
188191-- | `Alias`es are proxies for a type level string or `Symbol`
189192-- and have an `IsLabel` instance so that with @-XOverloadedLabels@
@@ -367,21 +370,29 @@ type family SameFields
367370 = AllZip SameField fields columns
368371
369372type (:=>) (constraints :: [constraint]) ty = '(constraints,ty)
373+infixr 7 :=>
370374
371375data ColumnConstraint
372376 = Default
373377 | Unique
374378 | References Symbol Symbol
375379
376−-- type DropDefault constraints = AsSet (DropDefaultList constraints)
377−
378−-- type family DropDefaultList constraints where
379−-- DropDefaultList '[] = '[]
380−-- DropDefaultList ( 'Default ': constraints) = constraints
381−-- DropDefaultList (constraint ': constraints) =
382−-- constraint ': DropDefaultList constraints
380+type instance Cmp 'Default 'Default = 'EQ
381+type instance Cmp 'Unique 'Unique = 'EQ
382+type instance Cmp ('References tab0 col0) ('References tab1 col1) =
383+ If (Cmp tab0 tab1 == 'EQ) (Cmp col0 col1) (Cmp tab0 tab1)
384+type instance Cmp 'Default 'Unique = 'LT
385+type instance Cmp 'Unique 'Default = 'GT
386+type instance Cmp 'Default ('References tab col) = 'LT
387+type instance Cmp ('References tab col) 'Default = 'GT
388+type instance Cmp 'Unique ('References tab col) = 'LT
389+type instance Cmp ('References tab col) 'Unique = 'GT
383390
384391data TableConstraint'
385392 = Check
386− | Uniques [(Symbol, ColumnType)]
387− | ForeignKey ColumnsType Symbol ColumnsType
393+ | Uniques [Symbol]
394+ | ForeignKey [Symbol] Symbol [Symbol]
395+
396+type family Aliases xs where
397+ Aliases '[] = '[]
398+ Aliases ((alias ::: x) ': xs) = alias ': Aliases xs