385fd8e · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

add foreign key on delete and on update clauses

385fd8eEitan Chatav9 years ago

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

compare with dev

unifiedsplit

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

24 , renderAlias

25 , Aliased (As)

26 , renderAliased

27+ , IsTableColumn (..)

27 , NullityType (..)

28 , NullityType (..)

29+ , ColumnType (..)

30+ , Grouping (..)

31+ , SameTypes

32+ , AllNotNull

33+ , NotAllNull

28 , NullifyType

34 , NullifyType

29 , NullifyColumns

35 , NullifyColumns

30 , NullifyTables

36 , NullifyTables

31− , ColumnType (..)

32 , BaseType

37 , BaseType

33 , Create

38 , Create

34 , Drop

39 , Drop

35 , Alter

40 , Alter

36 , Rename

41 , Rename

37 , Join

42 , Join

38− , Grouping (..)

39− , IsTableColumn (..)

40 , module GHC.OverloadedLabels

43 , module GHC.OverloadedLabels

41 , module GHC.TypeLits

44 , module GHC.TypeLits

42 ) where

45 ) where

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

44import Data.ByteString

47import Data.ByteString

45import Data.Monoid

48import Data.Monoid

46import Data.String

49import Data.String

50+import GHC.Exts

47import GHC.OverloadedLabels

51import GHC.OverloadedLabels

48import GHC.TypeLits

52import GHC.TypeLits

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

129type family BaseType (ty :: ColumnType) where

133type family BaseType (ty :: ColumnType) where

130 BaseType (optionality (nullity pg)) = pg

134 BaseType (optionality (nullity pg)) = pg

131

135

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+

132type family NullifyType (ty :: ColumnType) where

151type family NullifyType (ty :: ColumnType) where

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

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

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

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

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

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

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

1035

1036primaryKey

1037− :: (SListI subcolumns, NotNullTypes subcolumns)

1037+ :: (SListI subcolumns, AllNotNull subcolumns)

1038 => NP (Column columns) subcolumns

1039 -> TableConstraint schema columns

1040primaryKey columns = UnsafeTableConstraint $

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

1042

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−

1053foreignKey

1043foreignKey

1054 :: ( HasTable reftable schema refcolumns

1044 :: ( HasTable reftable schema refcolumns

1055 , SameTypes subcolumns refsubcolumns

1045 , SameTypes subcolumns refsubcolumns

1056− , NotNullTypes subcolumns

1046+ , NotAllNull subcolumns

1057 , SListI subcolumns

1047 , SListI subcolumns

1058 , SListI refsubcolumns)

1048 , SListI refsubcolumns)

1059 => NP (Column columns) subcolumns

1049 => NP (Column columns) subcolumns

1060 -> Alias reftable

1050 -> Alias reftable

1061 -> NP (Column refcolumns) refsubcolumns

1051 -> NP (Column refcolumns) refsubcolumns

1052+ -> OnDelete

1053+ -> OnUpdate

1062 -> TableConstraint schema columns

1054 -> TableConstraint schema columns

1063−foreignKey columns reftable refcolumns = UnsafeTableConstraint $

1055+foreignKey columns reftable refcolumns onDelete onUpdate =

1056+ UnsafeTableConstraint $

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

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

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

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

1066− <+> parenthesized (renderCommaSeparated renderColumn refcolumns)

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"

1067

1084

1068{-----------------------------------------

1085{-----------------------------------------

1069DROP statements

1086DROP statements

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

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

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

270 [ primaryKey (Column #id :* Nil)

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

272+ OnDeleteCascade OnUpdateRestrict

272 , unique (Column #email :* Nil)

273 , unique (Column #email :* Nil)

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

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

274 ]

275 ]

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

282 \ userid integer NOT NULL,\

283 \ userid integer NOT NULL,\

283 \ email text NOT NULL,\

284 \ email text NOT NULL,\

284 \ PRIMARY KEY (id),\

285 \ PRIMARY KEY (id),\

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

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

287+ \ ON DELETE CASCADE ON UPDATE RESTRICT,\

286 \ UNIQUE (email),\

288 \ UNIQUE (email),\

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

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

288 it "should render DROP TABLE statements" $ do

290 it "should render DROP TABLE statements" $ do