385fd8e · squeal · git.iko.soy

git.iko.soy/squeal

add foreign key on delete and on update clauses

commit385fd8e7768a21918e513163d2d952de8320bbb3 authorEitan Chatav <eitan.chatav@gmail.com> dateWed 16 Aug 2017, 16:41 (9 years ago) parent8dabc53

3 files changed+58−20

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+22−3 squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+33−16 squeal-postgresql/test/Squeal/PostgreSQL/StatementSpec.hs+3−1

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+22−3

@@ -24,19 +24,22 @@ module Squeal.PostgreSQL.Schema

2424 , renderAlias

2525 , Aliased (As)

2626 , renderAliased

27+ , IsTableColumn (..)

2728 , NullityType (..)

29+ , ColumnType (..)

30+ , Grouping (..)

31+ , SameTypes

32+ , AllNotNull

33+ , NotAllNull

2834 , NullifyType

2935 , NullifyColumns

3036 , NullifyTables

31− , ColumnType (..)

3237 , BaseType

3338 , Create

3439 , Drop

3540 , Alter

3641 , Rename

3742 , Join

38− , Grouping (..)

39− , IsTableColumn (..)

4043 , module GHC.OverloadedLabels

4144 , module GHC.TypeLits

4245 ) where

@@ -44,6 +47,7 @@ module Squeal.PostgreSQL.Schema

4447import Data.ByteString

4548import Data.Monoid

4649import Data.String

50+import GHC.Exts

4751import GHC.OverloadedLabels

4852import GHC.TypeLits

4953

@@ -129,6 +133,21 @@ data Grouping

129133type family BaseType (ty :: ColumnType) where

130134 BaseType (optionality (nullity pg)) = pg

131135

136+type family SameTypes columns0 columns1 :: Constraint where

137+ SameTypes '[] '[] = ()

138+ SameTypes ((column0 ::: ty0) ': columns0) ((column1 ::: ty1) ': columns1)

139+ = (ty0 ~ ty1, SameTypes columns0 columns1)

140+

141+type family AllNotNull columns :: Constraint where

142+ AllNotNull '[] = ()

143+ AllNotNull ((column ::: (optionality ('NotNull ty))) ': columns)

144+ = AllNotNull columns

145+

146+type family NotAllNull columns :: Constraint where

147+ NotAllNull ((column ::: (optionality ('NotNull ty))) ': columns) = ()

148+ NotAllNull ((column ::: (optionality ('Null ty))) ': columns)

149+ = NotAllNull columns

150+

132151type family NullifyType (ty :: ColumnType) where

133152 NullifyType (optionality ('Null ty)) = optionality ('Null ty)

134153 NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)

squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+33−16

@@ -1034,36 +1034,53 @@ unique columns = UnsafeTableConstraint $

10341034 "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)

10351035

10361036primaryKey

1037− :: (SListI subcolumns, NotNullTypes subcolumns)

1037+ :: (SListI subcolumns, AllNotNull subcolumns)

10381038 => NP (Column columns) subcolumns

10391039 -> TableConstraint schema columns

10401040primaryKey columns = UnsafeTableConstraint $

10411041 "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

10421042

1043−type family SameTypes columns0 columns1 :: Constraint where

1044− SameTypes '[] '[] = ()

1045− SameTypes ((column0 ::: ty0) ': columns0) ((column1 ::: ty1) ': columns1)

1046− = (ty0 ~ ty1, SameTypes columns0 columns1)

1047−

1048−type family NotNullTypes columns :: Constraint where

1049− NotNullTypes '[] = ()

1050− NotNullTypes ((column ::: (optionality ('NotNull ty))) ': columns)

1051− = NotNullTypes columns

1052−

10531043foreignKey

10541044 :: ( HasTable reftable schema refcolumns

10551045 , SameTypes subcolumns refsubcolumns

1056− , NotNullTypes subcolumns

1046+ , NotAllNull subcolumns

10571047 , SListI subcolumns

10581048 , SListI refsubcolumns)

10591049 => NP (Column columns) subcolumns

10601050 -> Alias reftable

10611051 -> NP (Column refcolumns) refsubcolumns

1052+ -> OnDelete

1053+ -> OnUpdate

10621054 -> TableConstraint schema columns

1063−foreignKey columns reftable refcolumns = UnsafeTableConstraint $

1064− "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

1065− <+> "REFERENCES" <+> renderAlias reftable

1066− <+> parenthesized (renderCommaSeparated renderColumn refcolumns)

1055+foreignKey columns reftable refcolumns onDelete onUpdate =

1056+ UnsafeTableConstraint $

1057+ "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

1058+ <+> "REFERENCES" <+> renderAlias reftable

1059+ <+> parenthesized (renderCommaSeparated renderColumn refcolumns)

1060+ <+> renderOnDelete onDelete

1061+ <+> renderOnUpdate onUpdate

1062+

1063+data OnDelete

1064+ = OnDeleteNoAction

1065+ | OnDeleteRestrict

1066+ | OnDeleteCascade

1067+

1068+renderOnDelete :: OnDelete -> ByteString

1069+renderOnDelete = \case

1070+ OnDeleteNoAction -> "ON DELETE NO ACTION"

1071+ OnDeleteRestrict -> "ON DELETE RESTRICT"

1072+ OnDeleteCascade -> "ON DELETE CASCADE"

1073+

1074+data OnUpdate

1075+ = OnUpdateNoAction

1076+ | OnUpdateRestrict

1077+ | OnUpdateCascade

1078+

1079+renderOnUpdate :: OnUpdate -> ByteString

1080+renderOnUpdate = \case

1081+ OnUpdateNoAction -> "ON UPDATE NO ACTION"

1082+ OnUpdateRestrict -> "ON UPDATE RESTRICT"

1083+ OnUpdateCascade -> "ON UPDATE CASCADE"

10671084

10681085{-----------------------------------------

10691086DROP statements

squeal-postgresql/test/Squeal/PostgreSQL/StatementSpec.hs+3−1

@@ -269,6 +269,7 @@ spec = do

269269 (text & notNull) `As` #email :* Nil )

270270 [ primaryKey (Column #id :* Nil)

271271 , foreignKey (Column #userid :* Nil) #users (Column #id :* Nil)

272+ OnDeleteCascade OnUpdateRestrict

272273 , unique (Column #email :* Nil)

273274 , check (#email /=* "")

274275 ]

@@ -282,7 +283,8 @@ spec = do

282283 \ userid integer NOT NULL,\

283284 \ email text NOT NULL,\

284285 \ PRIMARY KEY (id),\

285− \ FOREIGN KEY (userid) REFERENCES users (id),\

286+ \ FOREIGN KEY (userid) REFERENCES users (id)\

287+ \ ON DELETE CASCADE ON UPDATE RESTRICT,\

286288 \ UNIQUE (email),\

287289 \ CHECK ((email <> E'')));"

288290 it "should render DROP TABLE statements" $ do