f0422c5 · squeal · git.iko.soy

git.iko.soy/squeal

Merge pull request #30 from echatav/alter

Alter

commitf0422c50e0e830812cfb37ae4276055181b3413d authorEitan Chatav <eitan.chatav@gmail.com> dateSat 29 Jul 2017, 13:09 (9 years ago) parent687bbde 0eafb7b

4 files changed+345−216

compare with dev

unifiedsplit

squeel-postgresql/exe/Example.hs+1−1 squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+24 squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+316−211 squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+4−4

squeel-postgresql/exe/Example.hs+1−1

@@ -72,7 +72,7 @@ type Columns =

7272 ]

7373-- type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]

7474type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]

75−type Tables = '[ "table1" ::: Columns, "students" ::: StudentsColumns]

75+type Tables = '["students" ::: StudentsColumns, "table1" ::: Columns]

7676-- type OrderColumns =

7777-- [ "orderID" ::: 'NotNull 'PGInt4

7878-- , "orderVal" ::: 'NotNull 'PGText

squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+24

@@ -22,12 +22,17 @@ module Squeel.PostgreSQL.Schema

2222 , PGFloating

2323 , (:::)

2424 , Alias (Alias)

25+ , renderAlias

2526 , Aliased (As)

2627 , renderAliased

2728 , NullityType (..)

2829 , NullifyColumn

2930 , NullifyColumns

3031 , NullifyTable

32+ , Create

33+ , Drop

34+ , Alter

35+ , Rename

3136 , ColumnType (..)

3237 , module GHC.OverloadedLabels

3338 , module GHC.TypeLits

@@ -104,6 +109,9 @@ type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)

104109

105110data Alias (alias :: Symbol) = Alias (Proxy# alias)

106111

112+renderAlias :: KnownSymbol alias => Alias alias -> ByteString

113+renderAlias (Alias alias) = fromString (symbolVal' alias)

114+

107115instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where

108116 fromLabel = Alias

109117

@@ -140,3 +148,19 @@ type family NullifyColumns columns where

140148

141149type family NullifyTable table where

142150 NullifyTable (table ::: columns) = table ::: NullifyColumns columns

151+

152+type family Create alias x xs where

153+ Create alias x '[] = '[alias ::: x]

154+ Create alias y (x ': xs) = x ': Create alias y xs

155+

156+type family Drop alias xs where

157+ Drop alias ((alias ::: x) ': xs) = xs

158+ Drop alias (x ': xs) = x ': Drop alias xs

159+

160+type family Alter alias xs x where

161+ Alter alias ((alias ::: x0) ': xs) x1 = (alias ::: x1) ': xs

162+ Alter alias (x0 ': xs) x1 = x0 ': Alter alias xs x1

163+

164+type family Rename alias0 alias1 xs where

165+ Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

166+ Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+316−211

@@ -78,10 +78,8 @@ instance (HasColumn column columns ty, tables ~ '[table ::: columns])

7878(&.)

7979 :: (HasTable table tables columns, HasColumn column columns ty)

8080 => Alias table -> Alias column -> Expression params tables ty

81−Alias table &. Alias column = UnsafeExpression $

82− fromString (symbolVal' table)

83− <> "." <>

84− fromString (symbolVal' column)

81+table &. column = UnsafeExpression $

82+ renderAlias table <> "." <> renderAlias column

8583

8684def :: Expression params '[] ('Optional (nullity ty))

8785def = UnsafeExpression "DEFAULT"

@@ -379,6 +377,136 @@ instance HasTable table schema columns

379377 => IsLabel table (Table params schema columns) where

380378 fromLabel = getTable

381379

380+{-----------------------------------------

381+type expressions

382+-----------------------------------------}

383+

384+newtype TypeExpression (ty :: ColumnType)

385+ = UnsafeTypeExpression { renderTypeExpression :: ByteString }

386+ deriving (Show,Eq)

387+

388+bool :: TypeExpression ('Required ('Null 'PGBool))

389+bool = UnsafeTypeExpression "bool"

390+int2 :: TypeExpression ('Required ('Null 'PGInt2))

391+int2 = UnsafeTypeExpression "int2"

392+smallint :: TypeExpression ('Required ('Null 'PGInt2))

393+smallint = UnsafeTypeExpression "smallint"

394+int4 :: TypeExpression ('Required ('Null 'PGInt4))

395+int4 = UnsafeTypeExpression "int4"

396+int :: TypeExpression ('Required ('Null 'PGInt4))

397+int = UnsafeTypeExpression "int"

398+integer :: TypeExpression ('Required ('Null 'PGInt4))

399+integer = UnsafeTypeExpression "integer"

400+int8 :: TypeExpression ('Required ('Null 'PGInt8))

401+int8 = UnsafeTypeExpression "int8"

402+bigint :: TypeExpression ('Required ('Null 'PGInt8))

403+bigint = UnsafeTypeExpression "bigint"

404+numeric :: TypeExpression ('Required ('Null 'PGNumeric))

405+numeric = UnsafeTypeExpression "numeric"

406+float4 :: TypeExpression ('Required ('Null 'PGFloat4))

407+float4 = UnsafeTypeExpression "float4"

408+real :: TypeExpression ('Required ('Null 'PGFloat4))

409+real = UnsafeTypeExpression "real"

410+float8 :: TypeExpression ('Required ('Null 'PGFloat8))

411+float8 = UnsafeTypeExpression "float8"

412+doublePrecision :: TypeExpression ('Required ('Null 'PGFloat8))

413+doublePrecision = UnsafeTypeExpression "double precision"

414+serial2 :: TypeExpression ('Optional ('NotNull 'PGInt2))

415+serial2 = UnsafeTypeExpression "serial2"

416+smallserial :: TypeExpression ('Optional ('NotNull 'PGInt2))

417+smallserial = UnsafeTypeExpression "smallserial"

418+serial4 :: TypeExpression ('Optional ('NotNull 'PGInt4))

419+serial4 = UnsafeTypeExpression "serial4"

420+serial :: TypeExpression ('Optional ('NotNull 'PGInt4))

421+serial = UnsafeTypeExpression "serial"

422+serial8 :: TypeExpression ('Optional ('NotNull 'PGInt8))

423+serial8 = UnsafeTypeExpression "serial8"

424+bigserial :: TypeExpression ('Optional ('NotNull 'PGInt8))

425+bigserial = UnsafeTypeExpression "bigserial"

426+money :: TypeExpression ('Required ('Null 'PGMoney))

427+money = UnsafeTypeExpression "money"

428+text :: TypeExpression ('Required ('Null 'PGText))

429+text = UnsafeTypeExpression "text"

430+char

431+ :: KnownNat n

432+ => proxy n

433+ -> TypeExpression ('Required ('Null ('PGChar n)))

434+char (_ :: proxy n) = UnsafeTypeExpression $

435+ "char(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

436+character

437+ :: KnownNat n

438+ => proxy n

439+ -> TypeExpression ('Required ('Null ('PGChar n)))

440+character (_ :: proxy n) = UnsafeTypeExpression $

441+ "character(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

442+varchar

443+ :: KnownNat n

444+ => proxy n

445+ -> TypeExpression ('Required ('Null ('PGVarChar n)))

446+varchar (_ :: proxy n) = UnsafeTypeExpression $

447+ "varchar(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

448+characterVarying

449+ :: KnownNat n

450+ => proxy n

451+ -> TypeExpression ('Required ('Null ('PGVarChar n)))

452+characterVarying (_ :: proxy n) = UnsafeTypeExpression $

453+ "character varying(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

454+bytea :: TypeExpression ('Required ('Null ('PGBytea)))

455+bytea = UnsafeTypeExpression "bytea"

456+timestamp :: TypeExpression ('Required ('Null ('PGTimestamp)))

457+timestamp = UnsafeTypeExpression "timestamp"

458+timestampWithTimeZone :: TypeExpression ('Required ('Null ('PGTimestampTZ)))

459+timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

460+date :: TypeExpression ('Required ('Null ('PGDate)))

461+date = UnsafeTypeExpression "date"

462+time :: TypeExpression ('Required ('Null ('PGTime)))

463+time = UnsafeTypeExpression "time"

464+timeWithTimeZone :: TypeExpression ('Required ('Null ('PGTimeTZ)))

465+timeWithTimeZone = UnsafeTypeExpression "time with time zone"

466+interval :: TypeExpression ('Required ('Null ('PGInterval)))

467+interval = UnsafeTypeExpression "interval"

468+uuid :: TypeExpression ('Required ('Null ('PGUuid)))

469+uuid = UnsafeTypeExpression "uuid"

470+json :: TypeExpression ('Required ('Null ('PGJson)))

471+json = UnsafeTypeExpression "json"

472+jsonb :: TypeExpression ('Required ('Null ('PGJsonb)))

473+jsonb = UnsafeTypeExpression "jsonb"

474+

475+notNull

476+ :: TypeExpression ('Required ('Null ty))

477+ -> TypeExpression ('Required ('NotNull ty))

478+notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <> " NOT NULL"

479+default_

480+ :: Expression '[] '[] ('Required ty)

481+ -> TypeExpression ('Required ty)

482+ -> TypeExpression ('Optional ty)

483+default_ x ty = UnsafeTypeExpression $

484+ renderTypeExpression ty <> " DEFAULT " <> renderExpression x

485+

486+class PGTyped (ty :: PGType) where

487+ pgtype :: TypeExpression ('Required ('Null ty))

488+instance PGTyped 'PGBool where pgtype = bool

489+instance PGTyped 'PGInt2 where pgtype = int2

490+instance PGTyped 'PGInt4 where pgtype = int4

491+instance PGTyped 'PGInt8 where pgtype = int8

492+instance PGTyped 'PGNumeric where pgtype = numeric

493+instance PGTyped 'PGFloat4 where pgtype = float4

494+instance PGTyped 'PGFloat8 where pgtype = float8

495+instance PGTyped 'PGMoney where pgtype = money

496+instance PGTyped 'PGText where pgtype = text

497+instance KnownNat n => PGTyped ('PGChar n) where pgtype = char (Proxy @n)

498+instance KnownNat n => PGTyped ('PGVarChar n) where pgtype = varchar (Proxy @n)

499+instance PGTyped 'PGBytea where pgtype = bytea

500+instance PGTyped 'PGTimestamp where pgtype = timestamp

501+instance PGTyped 'PGTimestampTZ where pgtype = timestampWithTimeZone

502+instance PGTyped 'PGDate where pgtype = date

503+instance PGTyped 'PGTime where pgtype = time

504+instance PGTyped 'PGTimeTZ where pgtype = timeWithTimeZone

505+instance PGTyped 'PGInterval where pgtype = interval

506+instance PGTyped 'PGUuid where pgtype = uuid

507+instance PGTyped 'PGJson where pgtype = json

508+instance PGTyped 'PGJsonb where pgtype = jsonb

509+

382510{-----------------------------------------

383511statements

384512-----------------------------------------}

@@ -526,19 +654,22 @@ where_

526654 :: Predicate params tables

527655 -> TableExpression params schema tables

528656 -> TableExpression params schema tables

529−where_ wh (TableExpression tabs whs lims offs) = TableExpression tabs (wh:whs) lims offs

657+where_ wh (TableExpression tabs whs lims offs) =

658+ TableExpression tabs (wh:whs) lims offs

530659

531660limit

532661 :: Expression params '[] ('Required ('NotNull 'PGInt8))

533662 -> TableExpression params schema tables

534663 -> TableExpression params schema tables

535−limit lim (TableExpression tabs whs lims offs) = TableExpression tabs whs (lim:lims) offs

664+limit lim (TableExpression tabs whs lims offs) =

665+ TableExpression tabs whs (lim:lims) offs

536666

537667offset

538668 :: Expression params '[] ('Required ('NotNull 'PGInt8))

539669 -> TableExpression params schema tables

540670 -> TableExpression params schema tables

541−offset off (TableExpression tabs whs lims offs) = TableExpression tabs whs lims (off:offs)

671+offset off (TableExpression tabs whs lims offs) =

672+ TableExpression tabs whs lims (off:offs)

542673

543674newtype Selection

544675 (params :: [ColumnType])

@@ -558,8 +689,8 @@ dotStarFrom

558689 => Alias table

559690 -> TableExpression params schema tables

560691 -> Selection params schema columns

561−Alias tab `dotStarFrom` tabs = UnsafeSelection $

562− fromString (symbolVal' tab) <> ".* FROM " <> renderTableExpression tabs

692+table `dotStarFrom` tables = UnsafeSelection $

693+ renderAlias table <> ".* FROM " <> renderTableExpression tables

563694

564695from

565696 :: SListI columns

@@ -588,140 +719,14 @@ subselect selection = join (Subselect selection)

588719CREATE statements

589720-----------------------------------------}

590721

591−newtype TypeExpression (ty :: ColumnType)

592− = UnsafeTypeExpression { renderTypeExpression :: ByteString }

593− deriving (Show,Eq)

594−

595−bool :: TypeExpression ('Required ('Null 'PGBool))

596−bool = UnsafeTypeExpression "bool"

597−int2 :: TypeExpression ('Required ('Null 'PGInt2))

598−int2 = UnsafeTypeExpression "int2"

599−smallint :: TypeExpression ('Required ('Null 'PGInt2))

600−smallint = UnsafeTypeExpression "smallint"

601−int4 :: TypeExpression ('Required ('Null 'PGInt4))

602−int4 = UnsafeTypeExpression "int4"

603−int :: TypeExpression ('Required ('Null 'PGInt4))

604−int = UnsafeTypeExpression "int"

605−integer :: TypeExpression ('Required ('Null 'PGInt4))

606−integer = UnsafeTypeExpression "integer"

607−int8 :: TypeExpression ('Required ('Null 'PGInt8))

608−int8 = UnsafeTypeExpression "int8"

609−bigint :: TypeExpression ('Required ('Null 'PGInt8))

610−bigint = UnsafeTypeExpression "bigint"

611−numeric :: TypeExpression ('Required ('Null 'PGNumeric))

612−numeric = UnsafeTypeExpression "numeric"

613−float4 :: TypeExpression ('Required ('Null 'PGFloat4))

614−float4 = UnsafeTypeExpression "float4"

615−real :: TypeExpression ('Required ('Null 'PGFloat4))

616−real = UnsafeTypeExpression "real"

617−float8 :: TypeExpression ('Required ('Null 'PGFloat8))

618−float8 = UnsafeTypeExpression "float8"

619−doublePrecision :: TypeExpression ('Required ('Null 'PGFloat8))

620−doublePrecision = UnsafeTypeExpression "double precision"

621−serial2 :: TypeExpression ('Optional ('NotNull 'PGInt2))

622−serial2 = UnsafeTypeExpression "serial2"

623−smallserial :: TypeExpression ('Optional ('NotNull 'PGInt2))

624−smallserial = UnsafeTypeExpression "smallserial"

625−serial4 :: TypeExpression ('Optional ('NotNull 'PGInt4))

626−serial4 = UnsafeTypeExpression "serial4"

627−serial :: TypeExpression ('Optional ('NotNull 'PGInt4))

628−serial = UnsafeTypeExpression "serial"

629−serial8 :: TypeExpression ('Optional ('NotNull 'PGInt8))

630−serial8 = UnsafeTypeExpression "serial8"

631−bigserial :: TypeExpression ('Optional ('NotNull 'PGInt8))

632−bigserial = UnsafeTypeExpression "bigserial"

633−money :: TypeExpression ('Required ('Null 'PGMoney))

634−money = UnsafeTypeExpression "money"

635−text :: TypeExpression ('Required ('Null 'PGText))

636−text = UnsafeTypeExpression "text"

637−char

638− :: KnownNat n

639− => proxy n

640− -> TypeExpression ('Required ('Null ('PGChar n)))

641−char (_ :: proxy n) = UnsafeTypeExpression $

642− "char(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

643−character

644− :: KnownNat n

645− => proxy n

646− -> TypeExpression ('Required ('Null ('PGChar n)))

647−character (_ :: proxy n) = UnsafeTypeExpression $

648− "character(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

649−varchar

650− :: KnownNat n

651− => proxy n

652− -> TypeExpression ('Required ('Null ('PGVarChar n)))

653−varchar (_ :: proxy n) = UnsafeTypeExpression $

654− "varchar(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

655−characterVarying

656− :: KnownNat n

657− => proxy n

658− -> TypeExpression ('Required ('Null ('PGVarChar n)))

659−characterVarying (_ :: proxy n) = UnsafeTypeExpression $

660− "character varying(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

661−bytea :: TypeExpression ('Required ('Null ('PGBytea)))

662−bytea = UnsafeTypeExpression "bytea"

663−timestamp :: TypeExpression ('Required ('Null ('PGTimestamp)))

664−timestamp = UnsafeTypeExpression "timestamp"

665−timestampWithTimeZone :: TypeExpression ('Required ('Null ('PGTimestampTZ)))

666−timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

667−date :: TypeExpression ('Required ('Null ('PGDate)))

668−date = UnsafeTypeExpression "date"

669−time :: TypeExpression ('Required ('Null ('PGTime)))

670−time = UnsafeTypeExpression "time"

671−timeWithTimeZone :: TypeExpression ('Required ('Null ('PGTimeTZ)))

672−timeWithTimeZone = UnsafeTypeExpression "time with time zone"

673−interval :: TypeExpression ('Required ('Null ('PGInterval)))

674−interval = UnsafeTypeExpression "interval"

675−uuid :: TypeExpression ('Required ('Null ('PGUuid)))

676−uuid = UnsafeTypeExpression "uuid"

677−json :: TypeExpression ('Required ('Null ('PGJson)))

678−json = UnsafeTypeExpression "json"

679−jsonb :: TypeExpression ('Required ('Null ('PGJsonb)))

680−jsonb = UnsafeTypeExpression "jsonb"

681−

682−notNull

683− :: TypeExpression ('Required ('Null ty))

684− -> TypeExpression ('Required ('NotNull ty))

685−notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <> " NOT NULL"

686−default_

687− :: Expression '[] '[] ('Required ty)

688− -> TypeExpression ('Required ty)

689− -> TypeExpression ('Optional ty)

690−default_ x ty = UnsafeTypeExpression $

691− renderTypeExpression ty <> " DEFAULT " <> renderExpression x

692−

693−class PGTyped (ty :: PGType) where

694− pgtype :: TypeExpression ('Required ('Null ty))

695−instance PGTyped 'PGBool where pgtype = bool

696−instance PGTyped 'PGInt2 where pgtype = int2

697−instance PGTyped 'PGInt4 where pgtype = int4

698−instance PGTyped 'PGInt8 where pgtype = int8

699−instance PGTyped 'PGNumeric where pgtype = numeric

700−instance PGTyped 'PGFloat4 where pgtype = float4

701−instance PGTyped 'PGFloat8 where pgtype = float8

702−instance PGTyped 'PGMoney where pgtype = money

703−instance PGTyped 'PGText where pgtype = text

704−instance KnownNat n => PGTyped ('PGChar n) where pgtype = char (Proxy @n)

705−instance KnownNat n => PGTyped ('PGVarChar n) where pgtype = varchar (Proxy @n)

706−instance PGTyped 'PGBytea where pgtype = bytea

707−instance PGTyped 'PGTimestamp where pgtype = timestamp

708−instance PGTyped 'PGTimestampTZ where pgtype = timestampWithTimeZone

709−instance PGTyped 'PGDate where pgtype = date

710−instance PGTyped 'PGTime where pgtype = time

711−instance PGTyped 'PGTimeTZ where pgtype = timeWithTimeZone

712−instance PGTyped 'PGInterval where pgtype = interval

713−instance PGTyped 'PGUuid where pgtype = uuid

714−instance PGTyped 'PGJson where pgtype = json

715−instance PGTyped 'PGJsonb where pgtype = jsonb

716−

717722createTable

718723 :: (KnownSymbol table, SListI columns)

719724 => Alias table

720725 -> NP (Aliased TypeExpression) columns

721− -> Statement '[] '[] schema ((table ::: columns) ': schema)

722−createTable (Alias table) columns = UnsafeStatement $ mconcat

726+ -> Statement '[] '[] schema (Create table columns schema)

727+createTable table columns = UnsafeStatement $ mconcat

723728 [ "CREATE TABLE "

724− , fromString $ symbolVal' table

729+ , renderAlias table

725730 , " ("

726731 , ByteString.intercalate ", " . hcollapse $

727732 hmap (K . renderColumn) columns

@@ -729,24 +734,125 @@ createTable (Alias table) columns = UnsafeStatement $ mconcat

729734 ]

730735 where

731736 renderColumn :: Aliased TypeExpression x -> ByteString

732− renderColumn (ty `As` Alias column) =

733− fromString (symbolVal' column) <> " " <> renderTypeExpression ty

737+ renderColumn (ty `As` column) =

738+ renderAlias column <> " " <> renderTypeExpression ty

734739

735740{-----------------------------------------

736741DROP statements

737742-----------------------------------------}

738743

739−class KnownSymbol table => DropTable table schema0 schema1

740− | table schema0 -> schema1 where

741− dropTable :: Alias table -> Statement '[] '[] schema0 schema1

742− dropTable (Alias table) = UnsafeStatement $

743− "DROP TABLE " <> fromString (symbolVal' table) <> ";"

744−instance {-# OVERLAPPING #-}

745− (KnownSymbol table, table ~ table', schema ~ schema')

746− => DropTable table ((table' ::: columns) ': schema) schema'

747−instance {-# OVERLAPPABLE #-}

748− DropTable table schema0 schema1

749− => DropTable table (table' ': schema0) (table' ': schema1)

744+dropTable

745+ :: KnownSymbol table

746+ => Alias table

747+ -> Statement '[] '[] schema (Drop table schema)

748+dropTable table = UnsafeStatement $

749+ "DROP TABLE " <> renderAlias table <> ";"

750+

751+{-----------------------------------------

752+ALTER statements

753+-----------------------------------------}

754+

755+alterTable

756+ :: HasTable table schema columns0

757+ => Alias table

758+ -> AlterTable columns0 columns1

759+ -> Statement '[] '[] schema (Alter table schema columns1)

760+alterTable table alteration = UnsafeStatement $

761+ "ALTER TABLE "

762+ <> renderAlias table

763+ <> " "

764+ <> renderAlterTable alteration

765+ <> ";"

766+

767+alterTableRename

768+ :: (KnownSymbol table0, KnownSymbol table1)

769+ => Alias table0

770+ -> Alias table1

771+ -> Statement '[] '[] schema (Rename table0 table1 schema)

772+alterTableRename table0 table1 = UnsafeStatement $

773+ "ALTER TABLE "

774+ <> renderAlias table0

775+ <> " RENAME TO "

776+ <> renderAlias table1

777+ <> ";"

778+

779+data AlterTable

780+ (columns0 :: [(Symbol, ColumnType)])

781+ (columns1 :: [(Symbol, ColumnType)]) =

782+ UnsafeAlterTable {renderAlterTable :: ByteString}

783+

784+addColumnDefault

785+ :: KnownSymbol column

786+ => Alias column

787+ -> TypeExpression ('Optional ty)

788+ -> AlterTable columns (Create column ('Optional ty) columns)

789+addColumnDefault column ty = UnsafeAlterTable $

790+ "ADD COLUMN "

791+ <> renderAlias column

792+ <> " "

793+ <> renderTypeExpression ty

794+

795+addColumnNull

796+ :: KnownSymbol column

797+ => Alias column

798+ -> TypeExpression ('Required ('Null ty))

799+ -> AlterTable columns ((column ::: 'Required ('Null ty)) ': columns)

800+addColumnNull column ty = UnsafeAlterTable $

801+ "ADD COLUMN "

802+ <> renderAlias column

803+ <> " "

804+ <> renderTypeExpression ty

805+

806+dropColumn

807+ :: KnownSymbol column

808+ => Alias column

809+ -> AlterTable columns (Drop column columns)

810+dropColumn column = UnsafeAlterTable $

811+ "DROP COLUMN " <> renderAlias column

812+

813+renameColumn

814+ :: (KnownSymbol column0, KnownSymbol column1)

815+ => Alias column0

816+ -> Alias column1

817+ -> AlterTable columns (Rename column0 column1 columns)

818+renameColumn column0 column1 = UnsafeAlterTable $

819+ "RENAME COLUMN " <> renderAlias column0

820+ <> " TO " <> renderAlias column1

821+

822+alterColumn

823+ :: (KnownSymbol column, HasColumn column columns ty0)

824+ => Alias column

825+ -> AlterColumn ty0 ty1

826+ -> AlterTable columns (Alter column columns ty1)

827+alterColumn column alteration = UnsafeAlterTable $

828+ "ALTER COLUMN " <> renderAlias column

829+ <> " " <> renderAlterColumn alteration

830+

831+data AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

832+ UnsafeAlterColumn {renderAlterColumn :: ByteString}

833+

834+setDefault

835+ :: Expression '[] '[] ('Required ty)

836+ -> AlterColumn ('Required ty) ('Optional ty)

837+setDefault expression = UnsafeAlterColumn $

838+ "SET DEFAULT " <> renderExpression expression

839+

840+dropDefault :: AlterColumn ('Optional ty) ('Required ty)

841+dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

842+

843+setNotNull

844+ :: AlterColumn (optionality ('Null ty)) (optionality ('NotNull ty))

845+setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

846+

847+dropNotNull

848+ :: AlterColumn (optionality ('NotNull ty)) (optionality ('Null ty))

849+dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

850+

851+alterType

852+ :: PGCast ty0 ty1

853+ => TypeExpression (optionality (nullity ty1))

854+ -> AlterColumn (optionality (nullity ty0)) (optionality (nullity ty1))

855+alterType ty = UnsafeAlterColumn $ "TYPE " <> renderTypeExpression ty

750856

751857{-----------------------------------------

752858INSERT statements

@@ -757,15 +863,15 @@ insertInto

757863 => Alias table

758864 -> NP (Aliased (Expression params '[])) columns

759865 -> Statement params '[] schema schema

760−insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "

761− <> fromString (symbolVal' table)

866+insertInto table expressions = UnsafeStatement $ "INSERT INTO "

867+ <> renderAlias table

762868 <> " (" <> ByteString.intercalate ", " aliases

763869 <> ") VALUES ("

764870 <> ByteString.intercalate ", " values

765871 <> ");"

766872 where

767873 aliases = hcollapse $ hmap

768− (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

874+ (\ (_ `As` name) -> K (renderAlias name))

769875 expressions

770876 values = hcollapse $ hmap

771877 (\ (expression `As` _) -> K (renderExpression expression))

@@ -777,10 +883,10 @@ insertIntoReturning

777883 -> NP (Aliased (Expression params '[])) columns

778884 -> NP (Aliased (Expression params '[table ::: columns])) results

779885 -> Statement params results schema schema

780−insertIntoReturning (Alias table) inserts results

886+insertIntoReturning table inserts results

781887 = UnsafeStatement . mconcat $

782888 [ "INSERT INTO "

783− , fromString (symbolVal' table)

889+ , renderAlias table

784890 , " (" <> ByteString.intercalate ", " aliases

785891 , ") VALUES ("

786892 , ByteString.intercalate ", " values

@@ -790,7 +896,7 @@ insertIntoReturning (Alias table) inserts results

790896 ]

791897 where

792898 aliases = hcollapse $ hmap

793− (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

899+ (\ (_ `As` name) -> K (renderAlias name))

794900 inserts

795901 values = hcollapse $ hmap

796902 (\ (expression `As` _) -> K (renderExpression expression))

@@ -804,51 +910,49 @@ insertIntoReturning (Alias table) inserts results

804910UPDATE statements

805911-----------------------------------------}

806912

807−set :: Expression params tables x -> (Maybe :.: Expression params tables) x

808−set = Comp . Just

913+data UpdateExpression params table ty

914+ = Same

915+ | Set (Expression params table ty)

809916

810−same :: (Maybe :.: Expression params tables) x

811−same = Comp Nothing

812−

813−renderSet

814− :: Aliased (Maybe :.: Expression params '[table ::: columns]) column

917+renderUpdateExpression

918+ :: Aliased (UpdateExpression params '[table ::: columns]) column

815919 -> Maybe ByteString

816−renderSet = \case

817− Comp (Just expression) `As` Alias column -> Just $ mconcat

818− [ fromString $ symbolVal' column

920+renderUpdateExpression = \case

921+ Same `As` _ -> Nothing

922+ Set expression `As` column -> Just $ mconcat

923+ [ renderAlias column

819924 , " = "

820925 , renderExpression expression

821926 ]

822− Comp Nothing `As` _ -> Nothing

823927

824928update

825929 :: (HasTable table schema columns, SListI columns)

826930 => Alias table

827− -> NP (Aliased (Maybe :.: Expression params '[table ::: columns])) columns

931+ -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns

828932 -> Predicate params '[table ::: columns]

829933 -> Statement params '[] schema schema

830−update (Alias table) columns wh = UnsafeStatement $ mconcat

934+update table columns wh = UnsafeStatement $ mconcat

831935 [ "UPDATE "

832− , fromString $ symbolVal' table

936+ , renderAlias table

833937 , " SET "

834938 , ByteString.intercalate ", " . catMaybes . hcollapse $

835− hmap (K . renderSet) columns

939+ hmap (K . renderUpdateExpression) columns

836940 , " WHERE ", renderExpression wh, ";"

837941 ]

838942

839943updateReturning

840944 :: (SListI columns, SListI results, HasTable table schema columns)

841945 => Alias table

842− -> NP (Aliased (Maybe :.: Expression params '[table ::: columns])) columns

946+ -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns

843947 -> Predicate params '[table ::: columns]

844948 -> NP (Aliased (Expression params '[table ::: columns])) results

845949 -> Statement params results schema schema

846−updateReturning (Alias table) updates wh results = UnsafeStatement $ mconcat

950+updateReturning table updates wh results = UnsafeStatement $ mconcat

847951 [ "UPDATE "

848− , fromString $ symbolVal' table

952+ , renderAlias table

849953 , " SET "

850954 , ByteString.intercalate ", " . catMaybes . hcollapse $

851− hmap (K . renderSet) updates

955+ hmap (K . renderUpdateExpression) updates

852956 , " WHERE ", renderExpression wh

853957 , " RETURNING ", renderList results

854958 , ";"

@@ -863,24 +967,24 @@ upsertInto

863967 :: (SListI columns, HasTable table schema columns)

864968 => Alias table

865969 -> NP (Aliased (Expression params '[])) columns

866− -> NP (Aliased (Maybe :.: Expression params '[table ::: columns])) columns

970+ -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns

867971 -> Predicate params '[table ::: columns]

868972 -> Statement params '[] schema schema

869−upsertInto (Alias table) inserts updates wh = UnsafeStatement . mconcat $

973+upsertInto table inserts updates wh = UnsafeStatement . mconcat $

870974 [ "INSERT INTO "

871− , fromString (symbolVal' table)

975+ , renderAlias table

872976 , " (" <> ByteString.intercalate ", " aliases

873977 , ") VALUES ("

874978 , ByteString.intercalate ", " values

875979 , ") ON CONFLICT UPDATE "

876− , fromString $ symbolVal' table

980+ , renderAlias table

877981 , " SET "

878982 , ByteString.intercalate ", " . catMaybes . hcollapse $

879− hmap (K . renderSet) updates

983+ hmap (K . renderUpdateExpression) updates

880984 , " WHERE ", renderExpression wh, ";"

881985 ] where

882986 aliases = hcollapse $ hmap

883− (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

987+ (\ (_ `As` name) -> K (renderAlias name))

884988 inserts

885989 values = hcollapse $ hmap

886990 (\ (expression `As` _) -> K (renderExpression expression))

@@ -890,47 +994,48 @@ upsertIntoReturning

890994 :: (SListI columns, SListI results, HasTable table schema columns)

891995 => Alias table

892996 -> NP (Aliased (Expression params '[])) columns

893− -> NP (Aliased (Maybe :.: Expression params '[table ::: columns])) columns

997+ -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns

894998 -> Predicate params '[table ::: columns]

895999 -> NP (Aliased (Expression params '[table ::: columns])) results

8961000 -> Statement params results schema schema

897−upsertIntoReturning (Alias table) inserts updates wh results = UnsafeStatement . mconcat $

898− [ "INSERT INTO "

899− , fromString (symbolVal' table)

900− , " (" <> ByteString.intercalate ", " aliases

901− , ") VALUES ("

902− , ByteString.intercalate ", " values

903− , ") ON CONFLICT UPDATE "

904− , fromString $ symbolVal' table

905− , " SET "

906− , ByteString.intercalate ", " . catMaybes . hcollapse $

907− hmap (K . renderSet) updates

908− , " WHERE ", renderExpression wh

909− , " RETURNING ", renderList results

910− , ";"

911− ] where

912− aliases = hcollapse $ hmap

913− (\ (_ `As` Alias name) -> K (fromString (symbolVal' name)))

914− inserts

915− values = hcollapse $ hmap

916− (\ (expression `As` _) -> K (renderExpression expression))

917− inserts

918− renderList

919− = ByteString.intercalate ", "

920− . hcollapse

921− . hmap (K . renderAliased renderExpression)

1001+upsertIntoReturning table inserts updates wh results =

1002+ UnsafeStatement . mconcat $

1003+ [ "INSERT INTO "

1004+ , renderAlias table

1005+ , " (" <> ByteString.intercalate ", " aliases

1006+ , ") VALUES ("

1007+ , ByteString.intercalate ", " values

1008+ , ") ON CONFLICT UPDATE "

1009+ , renderAlias table

1010+ , " SET "

1011+ , ByteString.intercalate ", " . catMaybes . hcollapse $

1012+ hmap (K . renderUpdateExpression) updates

1013+ , " WHERE ", renderExpression wh

1014+ , " RETURNING ", renderList results

1015+ , ";"

1016+ ] where

1017+ aliases = hcollapse $ hmap

1018+ (\ (_ `As` name) -> K (renderAlias name))

1019+ inserts

1020+ values = hcollapse $ hmap

1021+ (\ (expression `As` _) -> K (renderExpression expression))

1022+ inserts

1023+ renderList

1024+ = ByteString.intercalate ", "

1025+ . hcollapse

1026+ . hmap (K . renderAliased renderExpression)

9221027

9231028{-----------------------------------------

9241029DELETE statements

9251030-----------------------------------------}

9261031

9271032deleteFrom

928− :: (HasTable table schema columns, SListI columns)

1033+ :: HasTable table schema columns

9291034 => Alias table

9301035 -> Predicate params '[table ::: columns]

9311036 -> Statement params '[] schema schema

932−deleteFrom (Alias table) wh = UnsafeStatement $ mconcat

1037+deleteFrom table wh = UnsafeStatement $ mconcat

9331038 [ "DELETE FROM "

934− , fromString $ symbolVal' table

1039+ , renderAlias table

9351040 , " WHERE ", renderExpression wh, ";"

9361041 ]

squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+4−4

@@ -85,14 +85,14 @@ spec = do

8585 it "correctly renders simple UPDATEs" $ do

8686 let

8787 statement :: Statement '[] '[] Tables Tables

88− statement = update #table1 (set 2 `As` #col1 :* same `As` #col2 :* Nil) (#col1 /=* #col2)

88+ statement = update #table1 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) (#col1 /=* #col2)

8989 statement `shouldRenderAs`

9090 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"

9191 it "correctly renders returning UPDATEs" $ do

9292 let

9393 statement :: Statement '[] SumAndCol1 Tables Tables

9494 statement = updateReturning #table1

95− (set 2 `As` #col1 :* same `As` #col2 :* Nil)

95+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)

9696 (#col1 /=* #col2)

9797 ((#col1 + #col2) `As` #sum :* #col1 :* Nil)

9898 statement `shouldRenderAs`

@@ -102,7 +102,7 @@ spec = do

102102 statement :: Statement '[] '[] Tables Tables

103103 statement = upsertInto #table1

104104 (2 `As` #col1 :* 4 `As` #col2 :* Nil)

105− (set 2 `As` #col1 :* same `As` #col2 :* Nil)

105+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)

106106 (#col1 /=* #col2)

107107 statement `shouldRenderAs`

108108 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"

@@ -111,7 +111,7 @@ spec = do

111111 statement :: Statement '[] SumAndCol1 Tables Tables

112112 statement = upsertIntoReturning #table1

113113 (2 `As` #col1 :* 4 `As` #col2 :* Nil)

114− (set 2 `As` #col1 :* same `As` #col2 :* Nil)

114+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)

115115 (#col1 /=* #col2)

116116 ((#col1 + #col2) `As` #sum :* #col1 :* Nil)

117117 statement `shouldRenderAs`