f0422c5 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Merge pull request #30 from echatav/alter

f0422c5Eitan Chatav9 years ago

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

compare with dev

unifiedsplit

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

72 ]

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

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

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

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

76-- type OrderColumns =

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

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

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

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

22 , PGFloating

23 , (:::)

24 , Alias (Alias)

25+ , renderAlias

25 , Aliased (As)

26 , Aliased (As)

26 , renderAliased

27 , renderAliased

27 , NullityType (..)

28 , NullityType (..)

28 , NullifyColumn

29 , NullifyColumn

29 , NullifyColumns

30 , NullifyColumns

30 , NullifyTable

31 , NullifyTable

32+ , Create

33+ , Drop

34+ , Alter

35+ , Rename

31 , ColumnType (..)

36 , ColumnType (..)

32 , module GHC.OverloadedLabels

37 , module GHC.OverloadedLabels

33 , module GHC.TypeLits

38 , module GHC.TypeLits

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

104

109

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

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

106

111

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

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

114+

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

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

108 fromLabel = Alias

116 fromLabel = Alias

109

117

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

140

148

141type family NullifyTable table where

149type family NullifyTable table where

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

150 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])

78(&.)

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

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

81−Alias table &. Alias column = UnsafeExpression $

81+table &. column = UnsafeExpression $

82− fromString (symbolVal' table)

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

83− <> "." <>

84− fromString (symbolVal' column)

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

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

87def = UnsafeExpression "DEFAULT"

85def = UnsafeExpression "DEFAULT"

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

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

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

380 fromLabel = getTable

378 fromLabel = getTable

381

379

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+

382{-----------------------------------------

510{-----------------------------------------

383statements

511statements

384-----------------------------------------}

512-----------------------------------------}

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

526 :: Predicate params tables

654 :: Predicate params tables

527 -> TableExpression params schema tables

655 -> TableExpression params schema tables

528 -> TableExpression params schema tables

656 -> 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

530

659

531limit

660limit

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

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

533 -> TableExpression params schema tables

662 -> TableExpression params schema tables

534 -> TableExpression params schema tables

663 -> 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

536

666

537offset

667offset

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

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

539 -> TableExpression params schema tables

669 -> TableExpression params schema tables

540 -> TableExpression params schema tables

670 -> 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)

542

673

543newtype Selection

674newtype Selection

544 (params :: [ColumnType])

675 (params :: [ColumnType])

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

558 => Alias table

689 => Alias table

559 -> TableExpression params schema tables

690 -> TableExpression params schema tables

560 -> Selection params schema columns

691 -> Selection params schema columns

561−Alias tab `dotStarFrom` tabs = UnsafeSelection $

692+table `dotStarFrom` tables = UnsafeSelection $

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

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

563

694

564from

695from

565 :: SListI columns

696 :: SListI columns

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

588CREATE statements

719CREATE statements

589-----------------------------------------}

720-----------------------------------------}

590

721

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−

717createTable

722createTable

718 :: (KnownSymbol table, SListI columns)

723 :: (KnownSymbol table, SListI columns)

719 => Alias table

724 => Alias table

720 -> NP (Aliased TypeExpression) columns

725 -> NP (Aliased TypeExpression) columns

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

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

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

727+createTable table columns = UnsafeStatement $ mconcat

723 [ "CREATE TABLE "

728 [ "CREATE TABLE "

724− , fromString $ symbolVal' table

729+ , renderAlias table

725 , " ("

730 , " ("

726 , ByteString.intercalate ", " . hcollapse $

731 , ByteString.intercalate ", " . hcollapse $

727 hmap (K . renderColumn) columns

732 hmap (K . renderColumn) columns

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

729 ]

734 ]

730 where

735 where

731 renderColumn :: Aliased TypeExpression x -> ByteString

736 renderColumn :: Aliased TypeExpression x -> ByteString

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

737+ renderColumn (ty `As` column) =

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

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

734

739

735{-----------------------------------------

740{-----------------------------------------

736DROP statements

741DROP statements

737-----------------------------------------}

742-----------------------------------------}

738

743

744+dropTable

739−class KnownSymbol table => DropTable table schema0 schema1

745+ :: KnownSymbol table

740− | table schema0 -> schema1 where

746+ => Alias table

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

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)

742− dropTable (Alias table) = UnsafeStatement $

760+alterTable table alteration = UnsafeStatement $

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

761+ "ALTER TABLE "

744−instance {-# OVERLAPPING #-}

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

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

785+ :: KnownSymbol column

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

786+ => Alias column

747−instance {-# OVERLAPPABLE #-}

787+ -> TypeExpression ('Optional ty)

748− DropTable table schema0 schema1

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

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

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

750

856

751{-----------------------------------------

857{-----------------------------------------

752INSERT statements

858INSERT statements

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

757 => Alias table

863 => Alias table

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

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

759 -> Statement params '[] schema schema

865 -> Statement params '[] schema schema

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

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

761− <> fromString (symbolVal' table)

867+ <> renderAlias table

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

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

763 <> ") VALUES ("

869 <> ") VALUES ("

764 <> ByteString.intercalate ", " values

870 <> ByteString.intercalate ", " values

765 <> ");"

871 <> ");"

766 where

872 where

767 aliases = hcollapse $ hmap

873 aliases = hcollapse $ hmap

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

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

769 expressions

875 expressions

770 values = hcollapse $ hmap

876 values = hcollapse $ hmap

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

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

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

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

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

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

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

779 -> Statement params results schema schema

885 -> Statement params results schema schema

780−insertIntoReturning (Alias table) inserts results

886+insertIntoReturning table inserts results

781 = UnsafeStatement . mconcat $

887 = UnsafeStatement . mconcat $

782 [ "INSERT INTO "

888 [ "INSERT INTO "

783− , fromString (symbolVal' table)

889+ , renderAlias table

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

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

785 , ") VALUES ("

891 , ") VALUES ("

786 , ByteString.intercalate ", " values

892 , ByteString.intercalate ", " values

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

790 ]

896 ]

791 where

897 where

792 aliases = hcollapse $ hmap

898 aliases = hcollapse $ hmap

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

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

794 inserts

900 inserts

795 values = hcollapse $ hmap

901 values = hcollapse $ hmap

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

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

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

804UPDATE statements

910UPDATE statements

805-----------------------------------------}

911-----------------------------------------}

806

912

913+data UpdateExpression params table ty

914+ = Same

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

915+ | Set (Expression params table ty)

808−set = Comp . Just

809

916

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

917+renderUpdateExpression

811−same = Comp Nothing

812−

813−renderSet

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

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

815 -> Maybe ByteString

919 -> Maybe ByteString

816−renderSet = \case

920+renderUpdateExpression = \case

921+ Same `As` _ -> Nothing

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

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

818− [ fromString $ symbolVal' column

923+ [ renderAlias column

819 , " = "

924 , " = "

820 , renderExpression expression

925 , renderExpression expression

821 ]

926 ]

822− Comp Nothing `As` _ -> Nothing

823

927

824update

928update

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

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

826 => Alias table

930 => Alias table

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

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

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

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

829 -> Statement params '[] schema schema

933 -> Statement params '[] schema schema

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

934+update table columns wh = UnsafeStatement $ mconcat

831 [ "UPDATE "

935 [ "UPDATE "

832− , fromString $ symbolVal' table

936+ , renderAlias table

833 , " SET "

937 , " SET "

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

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

835− hmap (K . renderSet) columns

939+ hmap (K . renderUpdateExpression) columns

836 , " WHERE ", renderExpression wh, ";"

940 , " WHERE ", renderExpression wh, ";"

837 ]

941 ]

838

942

839updateReturning

943updateReturning

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

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

841 => Alias table

945 => Alias table

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

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

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

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

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

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

845 -> Statement params results schema schema

949 -> Statement params results schema schema

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

950+updateReturning table updates wh results = UnsafeStatement $ mconcat

847 [ "UPDATE "

951 [ "UPDATE "

848− , fromString $ symbolVal' table

952+ , renderAlias table

849 , " SET "

953 , " SET "

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

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

851− hmap (K . renderSet) updates

955+ hmap (K . renderUpdateExpression) updates

852 , " WHERE ", renderExpression wh

956 , " WHERE ", renderExpression wh

853 , " RETURNING ", renderList results

957 , " RETURNING ", renderList results

854 , ";"

958 , ";"

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

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

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

864 => Alias table

968 => Alias table

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

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

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

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

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

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

868 -> Statement params '[] schema schema

972 -> Statement params '[] schema schema

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

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

870 [ "INSERT INTO "

974 [ "INSERT INTO "

871− , fromString (symbolVal' table)

975+ , renderAlias table

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

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

873 , ") VALUES ("

977 , ") VALUES ("

874 , ByteString.intercalate ", " values

978 , ByteString.intercalate ", " values

875 , ") ON CONFLICT UPDATE "

979 , ") ON CONFLICT UPDATE "

876− , fromString $ symbolVal' table

980+ , renderAlias table

877 , " SET "

981 , " SET "

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

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

879− hmap (K . renderSet) updates

983+ hmap (K . renderUpdateExpression) updates

880 , " WHERE ", renderExpression wh, ";"

984 , " WHERE ", renderExpression wh, ";"

881 ] where

985 ] where

882 aliases = hcollapse $ hmap

986 aliases = hcollapse $ hmap

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

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

884 inserts

988 inserts

885 values = hcollapse $ hmap

989 values = hcollapse $ hmap

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

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

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

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

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

891 => Alias table

995 => Alias table

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

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

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

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

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

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

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

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

896 -> Statement params results schema schema

1000 -> Statement params results schema schema

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

1001+upsertIntoReturning table inserts updates wh results =

1002+ UnsafeStatement . mconcat $

898− [ "INSERT INTO "

1003+ [ "INSERT INTO "

899− , fromString (symbolVal' table)

1004+ , renderAlias table

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

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

901− , ") VALUES ("

1006+ , ") VALUES ("

902− , ByteString.intercalate ", " values

1007+ , ByteString.intercalate ", " values

903− , ") ON CONFLICT UPDATE "

1008+ , ") ON CONFLICT UPDATE "

904− , fromString $ symbolVal' table

1009+ , renderAlias table

905− , " SET "

1010+ , " SET "

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

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

907− hmap (K . renderSet) updates

1012+ hmap (K . renderUpdateExpression) updates

908− , " WHERE ", renderExpression wh

1013+ , " WHERE ", renderExpression wh

909− , " RETURNING ", renderList results

1014+ , " RETURNING ", renderList results

910− , ";"

1015+ , ";"

911− ] where

1016+ ] where

912− aliases = hcollapse $ hmap

1017+ aliases = hcollapse $ hmap

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

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

914− inserts

1019+ inserts

915− values = hcollapse $ hmap

1020+ values = hcollapse $ hmap

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

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

917− inserts

1022+ inserts

918− renderList

1023+ renderList

919− = ByteString.intercalate ", "

1024+ = ByteString.intercalate ", "

920− . hcollapse

1025+ . hcollapse

921− . hmap (K . renderAliased renderExpression)

1026+ . hmap (K . renderAliased renderExpression)

922

1027

923{-----------------------------------------

1028{-----------------------------------------

924DELETE statements

1029DELETE statements

925-----------------------------------------}

1030-----------------------------------------}

926

1031

927deleteFrom

1032deleteFrom

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

1033+ :: HasTable table schema columns

929 => Alias table

1034 => Alias table

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

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

931 -> Statement params '[] schema schema

1036 -> Statement params '[] schema schema

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

1037+deleteFrom table wh = UnsafeStatement $ mconcat

933 [ "DELETE FROM "

1038 [ "DELETE FROM "

934− , fromString $ symbolVal' table

1039+ , renderAlias table

935 , " WHERE ", renderExpression wh, ";"

1040 , " WHERE ", renderExpression wh, ";"

936 ]

1041 ]

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

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

85 it "correctly renders simple UPDATEs" $ do

86 let

87 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)

89 statement `shouldRenderAs`

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

91 it "correctly renders returning UPDATEs" $ do

92 let

93 statement :: Statement '[] SumAndCol1 Tables Tables

94 statement = updateReturning #table1

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

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

96 (#col1 /=* #col2)

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

98 statement `shouldRenderAs`

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

102 statement :: Statement '[] '[] Tables Tables

103 statement = upsertInto #table1

104 (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)

106 (#col1 /=* #col2)

107 statement `shouldRenderAs`

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

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

111 statement :: Statement '[] SumAndCol1 Tables Tables

112 statement = upsertIntoReturning #table1

113 (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)

115 (#col1 /=* #col2)

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

117 statement `shouldRenderAs`