8c905f5 · squeal · git.iko.soy

git.iko.soy/squeal

dropColumn

safely drop a column by also dropping table constraints involving that column

commit8c905f5697c4e844bd590f71cd92962c55c8bf4b authorEitan Chatav <eitan.chatav@gmail.com> dateSun 25 Mar 2018, 11:41 (9 years ago) parent647d1db

2 files changed+51−26

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+23−22 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+28−4

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+23−22

@@ -200,6 +200,20 @@ newtype TableConstraintExpression

200200 { renderTableConstraintExpression :: ByteString }

201201 deriving (GHC.Generic,Show,Eq,Ord,NFData)

202202

203+-- | @Column columns column@ is a witness that `column` is in `columns`.

204+data Column

205+ (columns :: ColumnsType)

206+ (column :: (Symbol,ColumnType))

207+ where

208+ Column

209+ :: Has column columns ty

210+ => Alias column

211+ -> Column columns (column ::: ty)

212+

213+-- | Render a `Column`.

214+renderColumn :: Column columns column -> ByteString

215+renderColumn (Column column) = renderAlias column

216+

203217-- | A `check` constraint is the most generic `TableConstraint` type.

204218-- It allows you to specify that the value in a certain column must satisfy

205219-- a Boolean (truth-value) expression.

@@ -209,30 +223,17 @@ newtype TableConstraintExpression

209223-- createTable #tab

210224-- ( (int & notNull) `As` #a :*

211225-- (int & notNull) `As` #b :* Nil )

212−-- ( check (#a .> #b) `As` #inequality :* Nil )

226+-- ( check (Column #a :* Column #b :* Nil) (#a .> #b) `As` #inequality :* Nil )

213227-- :}

214228-- "CREATE TABLE tab (a int NOT NULL, b int NOT NULL, CONSTRAINT inequality CHECK ((a > b)));"

215229check

216− :: Condition '[table ::: ColumnsToRelation columns] 'Ungrouped '[]

230+ :: NP (Column columns) subcolumns

231+ -> Condition '[table ::: ColumnsToRelation subcolumns] 'Ungrouped '[]

217232 -- ^ condition to check

218− -> TableConstraintExpression schema columns 'Check

219−check condition = UnsafeTableConstraintExpression $

233+ -> TableConstraintExpression schema columns ('Check (AliasesOf subcolumns))

234+check _cols condition = UnsafeTableConstraintExpression $

220235 "CHECK" <+> parenthesized (renderExpression condition)

221236

222−-- | @Column columns column@ is a witness that `column` is in `columns`.

223−data Column

224− (columns :: ColumnsType)

225− (column :: (Symbol,ColumnType))

226− where

227− Column

228− :: Has column columns ty

229− => Alias column

230− -> Column columns (column ::: ty)

231−

232−-- | Render a `Column`.

233−renderColumn :: Column columns column -> ByteString

234−renderColumn (Column column) = renderAlias column

235−

236237-- | A `unique` constraint ensure that the data contained in a column,

237238-- or a group of columns, is unique among all the rows in the table.

238239--

@@ -440,8 +441,8 @@ newtype AlterTable

440441-- let

441442-- definition :: Definition

442443-- '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

443−-- '["tab" ::: '["positive" ::: Check ] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

444−-- definition = alterTable #tab (addConstraint #positive (check (#col .> 0)))

444+-- '["tab" ::: '["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

445+-- definition = alterTable #tab (addConstraint #positive (check (Column #col :* Nil) (#col .> 0)))

445446-- in renderDefinition definition

446447-- :}

447448-- "ALTER TABLE tab ADD CONSTRAINT positive CHECK ((col > 0));"

@@ -461,7 +462,7 @@ addConstraint constraintName constraint = UnsafeAlterTable $

461462-- >>> :{

462463-- let

463464-- definition :: Definition

464−-- '["tab" ::: '["positive" ::: Check ] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

465+-- '["tab" ::: '["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

465466-- '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]

466467-- definition = alterTable #tab (dropConstraint #positive)

467468-- in renderDefinition definition

@@ -537,7 +538,7 @@ dropColumn

537538 => Alias column -- ^ column to remove

538539 -> AlterTable schema

539540 (constraints :=> columns)

540− (constraints :=> Drop column columns)

541+ (DropIfConstraintsInvolve column constraints :=> Drop column columns)

541542dropColumn column = UnsafeAlterTable $

542543 "DROP COLUMN" <+> renderAlias column

543544

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+28−4

@@ -54,6 +54,9 @@ module Squeal.PostgreSQL.Schema

5454 , TablesToRelations

5555 , ColumnConstraint (..)

5656 , TableConstraint (..)

57+ , Elem

58+ , ConstraintInvolves

59+ , DropIfConstraintsInvolve

5760 -- * Aliases

5861 , (:::)

5962 , Alias (Alias)

@@ -92,6 +95,7 @@ import Data.ByteString

9295import Data.Monoid

9396import Data.String

9497import Data.Word

98+import Data.Type.Bool

9599import Generics.SOP (AllZip)

96100import GHC.Generics (Generic)

97101import GHC.Exts

@@ -222,7 +226,7 @@ type ColumnsType = [(Symbol,ColumnType)]

222226-- | `TableConstraint` encodes various forms of data constraints

223227-- of columns in a table.

224228data TableConstraint

225− = Check

229+ = Check [Symbol]

226230 | Unique [Symbol]

227231 | PrimaryKey [Symbol]

228232 | ForeignKey [Symbol] Symbol [Symbol]

@@ -383,10 +387,14 @@ class IsTableColumn table column expression where

383387 infixl 9 !

384388instance IsTableColumn table column (Alias table, Alias column) where (!) = (,)

385389

390+-- | @Elem@ is a promoted `elem`.

391+type family Elem x xs where

392+ Elem x '[] = 'False

393+ Elem x (x ': xs) = 'True

394+ Elem x (_ ': xs) = Elem x xs

395+

386396-- | @In x xs@ is a constraint that proves that @x@ is in @xs@.

387−type family In x xs :: Constraint where

388− In x (x ': xs) = ()

389− In x (y ': xs) = In x xs

397+type family In x xs :: Constraint where In x xs = Elem x xs ~ 'True

390398

391399-- | `PGNum` is a constraint on `PGType` whose

392400-- `Squeal.PostgreSQL.Expression.Expression`s have a `Num` constraint.

@@ -513,3 +521,19 @@ type family SameFields

513521 ('Type.Newtype _module _datatype ('Type.Record _constructor fields))

514522 columns

515523 = AllZip SameField fields columns

524+

525+-- | Check if a `TableConstraint` involves a column

526+type family ConstraintInvolves column constraint where

527+ ConstraintInvolves column ('Check columns) = column `Elem` columns

528+ ConstraintInvolves column ('Unique columns) = column `Elem` columns

529+ ConstraintInvolves column ('PrimaryKey columns) = column `Elem` columns

530+ ConstraintInvolves column ('ForeignKey columns tab refcolumns)

531+ = column `Elem` columns

532+

533+-- | Drop all `TableConstraint`s that involve a column

534+type family DropIfConstraintsInvolve column constraints where

535+ DropIfConstraintsInvolve column '[] = '[]

536+ DropIfConstraintsInvolve column (alias ::: constraint ': constraints)

537+ = If (ConstraintInvolves column constraint)

538+ (DropIfConstraintsInvolve column constraints)

539+ (alias ::: constraint ': DropIfConstraintsInvolve column constraints)