7d644fe · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

some changes to Alter

7d644feEitan Chatav9 years ago

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+65−66

compare with dev

unifiedsplit

@@ -52,11 +52,10 @@ module Squeal.PostgreSQL.Definition

52 -- * Alter

53 , alterTable

54 , alterTableRename

55+ , AlterTable (UnsafeAlterTable, renderAlterTable)

55 , addConstraint

56 , addConstraint

56 , dropConstraint

57 , dropConstraint

57− , AlterTable (UnsafeAlterTable, renderAlterTable)

58+ , AddColumn (addColumn)

58− , addColumnDefault

59− , addColumnNull

60 , dropColumn

59 , dropColumn

61 , renameColumn

60 , renameColumn

62 , alterColumn

61 , alterColumn

@@ -344,7 +343,7 @@ type ForeignKeyed schema table reftable subcolumns refsubcolumns

344 , SOP.SListI subcolumns

343 , SOP.SListI subcolumns

345 , SOP.SListI refsubcolumns )

344 , SOP.SListI refsubcolumns )

346

345

347−-- | `OnDelete` indicates what to do with rows that reference a deleted row.

346+-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.

348data OnDeleteClause

347data OnDeleteClause

349 = OnDeleteNoAction

348 = OnDeleteNoAction

350 -- ^ if any referencing rows still exist when the constraint is checked,

349 -- ^ if any referencing rows still exist when the constraint is checked,

@@ -363,7 +362,7 @@ renderOnDeleteClause = \case

363 OnDeleteRestrict -> "ON DELETE RESTRICT"

362 OnDeleteRestrict -> "ON DELETE RESTRICT"

364 OnDeleteCascade -> "ON DELETE CASCADE"

363 OnDeleteCascade -> "ON DELETE CASCADE"

365

364

366−-- | Analagous to `OnDelete` there is also `OnUpdate` which is invoked

365+-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked

367-- when a referenced column is changed (updated).

366-- when a referenced column is changed (updated).

368data OnUpdateClause

367data OnUpdateClause

369 = OnUpdateNoAction

368 = OnUpdateNoAction

@@ -426,6 +425,15 @@ alterTableRename table0 table1 = UnsafeDefinition $

426 "ALTER TABLE" <+> renderAlias table0

425 "ALTER TABLE" <+> renderAlias table0

427 <+> "RENAME TO" <+> renderAlias table1 <> ";"

426 <+> "RENAME TO" <+> renderAlias table1 <> ";"

428

427

428+-- | An `AlterTable` describes the alteration to perform on the columns

429+-- of a table.

430+newtype AlterTable

431+ (schema :: TablesType)

432+ (table0 :: TableType)

433+ (table1 :: TableType) =

434+ UnsafeAlterTable {renderAlterTable :: ByteString}

435+ deriving (GHC.Generic,Show,Eq,Ord,NFData)

436+

429-- | An `addConstraint` adds a table constraint.

437-- | An `addConstraint` adds a table constraint.

430--

438--

431-- >>> :{

439-- >>> :{

@@ -438,10 +446,12 @@ alterTableRename table0 table1 = UnsafeDefinition $

438-- :}

446-- :}

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

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

440addConstraint

448addConstraint

441− :: KnownSymbol constraintName

449+ :: KnownSymbol alias

442− => Alias constraintName

450+ => Alias alias

443− -> TableConstraintExpression schema (TableToColumns table) constraint

451+ -> TableConstraintExpression schema columns constraint

444− -> AlterTable schema table (AddConstraint constraintName constraint table)

452+ -- ^ constraint to add

453+ -> AlterTable schema (constraints :=> columns)

454+ ((Create alias constraint constraints) :=> columns)

445addConstraint constraintName constraint = UnsafeAlterTable $

455addConstraint constraintName constraint = UnsafeAlterTable $

446 "ADD" <+> "CONSTRAINT" <+> renderAlias constraintName

456 "ADD" <+> "CONSTRAINT" <+> renderAlias constraintName

447 <+> renderTableConstraintExpression constraint

457 <+> renderTableConstraintExpression constraint

@@ -460,65 +470,51 @@ addConstraint constraintName constraint = UnsafeAlterTable $

460dropConstraint

470dropConstraint

461 :: KnownSymbol constraintName

471 :: KnownSymbol constraintName

462 => Alias constraintName

472 => Alias constraintName

473+ -- ^ constraint to drop

463 -> AlterTable schema

474 -> AlterTable schema

464 (constraints :=> columns)

475 (constraints :=> columns)

465 (Drop constraintName constraints :=> columns)

476 (Drop constraintName constraints :=> columns)

466dropConstraint constraint = UnsafeAlterTable $

477dropConstraint constraint = UnsafeAlterTable $

467 "DROP" <+> "CONSTRAINT" <+> renderAlias constraint

478 "DROP" <+> "CONSTRAINT" <+> renderAlias constraint

468

479

469−-- | An `AlterTable` describes the alteration to perform on the columns

480+-- | An `AddColumn` is either @NULL@ or has @DEFAULT@.

470−-- of a table.

481+class AddColumn ty where

471−newtype AlterTable

472− (schema :: TablesType)

473− (table0 :: TableType)

474− (table1 :: TableType) =

475− UnsafeAlterTable {renderAlterTable :: ByteString}

476− deriving (GHC.Generic,Show,Eq,Ord,NFData)

477−

478−-- | An `addColumnDefault` adds a new `Optional` column. The new column is

479−-- initially filled with whatever default value is given.

482+ -- | `addColumn` adds a new column, initially filled with whatever

483+ -- default value is given or with @NULL@.

480−--

484+ --

481−-- >>> :{

485+ -- >>> :{

482−-- let

486+ -- let

483−-- definition :: Definition

487+ -- definition :: Definition

484−-- '["tab" ::: '[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4]]

488+ -- '["tab" ::: '[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4]]

485−-- '["tab" ::: '[] :=>

489+ -- '["tab" ::: '[] :=>

486−-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4

490+ -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4

487−-- , "col2" ::: 'Def :=> 'Null 'PGtext ]]

491+ -- , "col2" ::: 'Def :=> 'Null 'PGtext ]]

488−-- definition = alterTable #tab

492+ -- definition = alterTable #tab (addColumn #col2 (text & default_ "foo"))

489−-- (addColumnDefault #col2 (text & default_ "foo"))

490−-- in renderDefinition definition

493+ -- in renderDefinition definition

491−-- :}

494+ -- :}

492−-- "ALTER TABLE tab ADD COLUMN col2 text DEFAULT E'foo';"

495+ -- "ALTER TABLE tab ADD COLUMN col2 text DEFAULT E'foo';"

493−addColumnDefault

496+ --

494− :: KnownSymbol column

495− => Alias column -- ^ column to add

496− -> TypeExpression ('Def :=> ty) -- ^ type of the new column

497− -> AlterTable schema table (AddColumn column ('Def :=> ty) table)

498−addColumnDefault column ty = UnsafeAlterTable $

499− "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty

500−

501−-- | An `addColumnNull` adds a new `Null` column. The new column is initially

502−-- filled with @NULL@s.

503−--

504−-- >>> :{

497+ -- >>> :{

505−-- let

498+ -- let

506−-- definition :: Definition

499+ -- definition :: Definition

507−-- '["tab" ::: '[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4]]

500+ -- '["tab" ::: '[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4]]

508−-- '["tab" ::: '[] :=>

501+ -- '["tab" ::: '[] :=>

509−-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4

502+ -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4

510−-- , "col2" ::: 'NoDef :=> 'Null 'PGtext ]]

503+ -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ]]

511−-- definition = alterTable #tab (addColumnNull #col2 text)

504+ -- definition = alterTable #tab (addColumn #col2 text)

512−-- in renderDefinition definition

505+ -- in renderDefinition definition

513−-- :}

506+ -- :}

514−-- "ALTER TABLE tab ADD COLUMN col2 text;"

507+ -- "ALTER TABLE tab ADD COLUMN col2 text;"

515−addColumnNull

508+ addColumn

516− :: KnownSymbol column

509+ :: KnownSymbol column

517− => Alias column -- ^ column to add

510+ => Alias column -- ^ column to add

518− -> TypeExpression ('NoDef :=> 'Null ty) -- ^ type of the new column

511+ -> TypeExpression ty -- ^ type of the new column

519− -> AlterTable schema table (AddColumn column ('NoDef :=> 'Null ty) table)

512+ -> AlterTable schema (constraints :=> columns)

513+ (constraints :=> Create column ty columns)

520−addColumnNull column ty = UnsafeAlterTable $

514+ addColumn column ty = UnsafeAlterTable $

521− "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty

515+ "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty

516+instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)

517+instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)

522

518

523-- | A `dropColumn` removes a column. Whatever data was in the column

519-- | A `dropColumn` removes a column. Whatever data was in the column

524-- disappears. Table constraints involving the column are dropped, too.

520-- disappears. Table constraints involving the column are dropped, too.

@@ -570,7 +566,8 @@ alterColumn

570 :: (KnownSymbol column, Has column columns ty0)

566 :: (KnownSymbol column, Has column columns ty0)

571 => Alias column -- ^ column to alter

567 => Alias column -- ^ column to alter

572 -> AlterColumn ty0 ty1 -- ^ alteration to perform

568 -> AlterColumn ty0 ty1 -- ^ alteration to perform

573− -> AlterTable schema ('[] :=> columns) ('[] :=> Alter column columns ty1)

569+ -> AlterTable schema (constraints :=> columns)

570+ (constraints :=> Alter column columns ty1)

574alterColumn column alteration = UnsafeAlterTable $

571alterColumn column alteration = UnsafeAlterTable $

575 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration

572 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration

576

573

@@ -594,7 +591,7 @@ newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

594-- "ALTER TABLE tab ALTER COLUMN col SET DEFAULT 5;"

591-- "ALTER TABLE tab ALTER COLUMN col SET DEFAULT 5;"

595setDefault

592setDefault

596 :: Expression '[] 'Ungrouped '[] ty -- ^ default value to set

593 :: Expression '[] 'Ungrouped '[] ty -- ^ default value to set

597− -> AlterColumn (constraints :=> ty) ('Def :=> ty)

594+ -> AlterColumn (constraint :=> ty) ('Def :=> ty)

598setDefault expression = UnsafeAlterColumn $

595setDefault expression = UnsafeAlterColumn $

599 "SET DEFAULT" <+> renderExpression expression

596 "SET DEFAULT" <+> renderExpression expression

600

597

@@ -625,7 +622,8 @@ dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

625-- in renderDefinition definition

622-- in renderDefinition definition

626-- :}

623-- :}

627-- "ALTER TABLE tab ALTER COLUMN col SET NOT NULL;"

624-- "ALTER TABLE tab ALTER COLUMN col SET NOT NULL;"

625+setNotNull

628−setNotNull :: AlterColumn (optionality ('Null ty)) (optionality ('NotNull ty))

626+ :: AlterColumn (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)

629setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

627setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

630

628

631-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.

629-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.

@@ -639,7 +637,8 @@ setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

639-- in renderDefinition definition

637-- in renderDefinition definition

640-- :}

638-- :}

641-- "ALTER TABLE tab ALTER COLUMN col DROP NOT NULL;"

639-- "ALTER TABLE tab ALTER COLUMN col DROP NOT NULL;"

640+dropNotNull

642−dropNotNull :: AlterColumn (optionality ('NotNull ty)) (optionality ('Null ty))

641+ :: AlterColumn (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)

643dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

642dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

644

643

645-- | An `alterType` converts a column to a different data type.

644-- | An `alterType` converts a column to a different data type.

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs−12

@@ -79,8 +79,6 @@ module Squeal.PostgreSQL.Schema

79 , NullifyRelations

80 , Join

81 , Create

82− , AddColumn

83− , AddConstraint

84 , Drop

82 , Drop

85 , Alter

83 , Alter

86 , Rename

84 , Rename

@@ -462,16 +460,6 @@ type family Create alias x xs where

462 Create alias x '[] = '[alias ::: x]

460 Create alias x '[] = '[alias ::: x]

463 Create alias y (x ': xs) = x ': Create alias y xs

461 Create alias y (x ': xs) = x ': Create alias y xs

464

462

465−-- | Add a column to a `TableType` with

466−-- `Squeal.PostgreSQL.Definition.addColumn`.

467−type family AddColumn alias x y where

468− AddColumn alias x (constraints :=> xs) = constraints :=> Create alias x xs

469−

470−-- | Add a constraint to a `TableType` with

471−-- `Squeal.PostgreSQL.Definition.addConstraint`.

472−type family AddConstraint alias x y where

473− AddConstraint alias x (constraints :=> xs) = Create alias x constraints :=> xs

474−

475-- | @Drop alias xs@ removes the type associated with @alias@ in @xs@

463-- | @Drop alias xs@ removes the type associated with @alias@ in @xs@

476-- and is used in `Squeal.PostgreSQL.Definition.dropTable` statements

464-- and is used in `Squeal.PostgreSQL.Definition.dropTable` statements

477-- and in @ALTER TABLE@ `Squeal.PostgreSQL.Definition.dropColumn` statements.

465-- and in @ALTER TABLE@ `Squeal.PostgreSQL.Definition.dropColumn` statements.