af3f5c1 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Create type family

af3f5c1Eitan 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+5

@@ -28,6 +28,7 @@ module Squeel.PostgreSQL.Schema

28 , NullifyColumn

29 , NullifyColumns

30 , NullifyTable

31+ , Create

31 , Drop

32 , Drop

32 , Alter

33 , Alter

33 , Rename

34 , Rename

@@ -144,6 +145,10 @@ type family NullifyColumns columns where

144type family NullifyTable table where

145type family NullifyTable table where

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

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

146

147

148+type family Create alias x xs where

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

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

151+

147type family Drop alias xs where

152type family Drop alias xs where

148 Drop alias ((alias ::: x) ': xs) = xs

153 Drop alias ((alias ::: x) ': xs) = xs

149 Drop alias (x ': xs) = x ': Drop alias xs

154 Drop alias (x ': xs) = x ': Drop alias xs

squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+133−129

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

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

380 fromLabel = getTable

381

382+{-----------------------------------------

383+type expressions

384+-----------------------------------------}

385+

386+newtype TypeExpression (ty :: ColumnType)

387+ = UnsafeTypeExpression { renderTypeExpression :: ByteString }

388+ deriving (Show,Eq)

389+

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

391+bool = UnsafeTypeExpression "bool"

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

393+int2 = UnsafeTypeExpression "int2"

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

395+smallint = UnsafeTypeExpression "smallint"

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

397+int4 = UnsafeTypeExpression "int4"

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

399+int = UnsafeTypeExpression "int"

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

401+integer = UnsafeTypeExpression "integer"

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

403+int8 = UnsafeTypeExpression "int8"

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

405+bigint = UnsafeTypeExpression "bigint"

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

407+numeric = UnsafeTypeExpression "numeric"

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

409+float4 = UnsafeTypeExpression "float4"

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

411+real = UnsafeTypeExpression "real"

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

413+float8 = UnsafeTypeExpression "float8"

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

415+doublePrecision = UnsafeTypeExpression "double precision"

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

417+serial2 = UnsafeTypeExpression "serial2"

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

419+smallserial = UnsafeTypeExpression "smallserial"

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

421+serial4 = UnsafeTypeExpression "serial4"

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

423+serial = UnsafeTypeExpression "serial"

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

425+serial8 = UnsafeTypeExpression "serial8"

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

427+bigserial = UnsafeTypeExpression "bigserial"

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

429+money = UnsafeTypeExpression "money"

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

431+text = UnsafeTypeExpression "text"

432+char

433+ :: KnownNat n

434+ => proxy n

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

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

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

438+character

439+ :: KnownNat n

440+ => proxy n

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

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

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

444+varchar

445+ :: KnownNat n

446+ => proxy n

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

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

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

450+characterVarying

451+ :: KnownNat n

452+ => proxy n

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

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

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

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

457+bytea = UnsafeTypeExpression "bytea"

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

459+timestamp = UnsafeTypeExpression "timestamp"

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

461+timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

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

463+date = UnsafeTypeExpression "date"

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

465+time = UnsafeTypeExpression "time"

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

467+timeWithTimeZone = UnsafeTypeExpression "time with time zone"

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

469+interval = UnsafeTypeExpression "interval"

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

471+uuid = UnsafeTypeExpression "uuid"

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

473+json = UnsafeTypeExpression "json"

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

475+jsonb = UnsafeTypeExpression "jsonb"

476+

477+notNull

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

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

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

481+default_

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

483+ -> TypeExpression ('Required ty)

484+ -> TypeExpression ('Optional ty)

485+default_ x ty = UnsafeTypeExpression $

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

487+

488+class PGTyped (ty :: PGType) where

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

490+instance PGTyped 'PGBool where pgtype = bool

491+instance PGTyped 'PGInt2 where pgtype = int2

492+instance PGTyped 'PGInt4 where pgtype = int4

493+instance PGTyped 'PGInt8 where pgtype = int8

494+instance PGTyped 'PGNumeric where pgtype = numeric

495+instance PGTyped 'PGFloat4 where pgtype = float4

496+instance PGTyped 'PGFloat8 where pgtype = float8

497+instance PGTyped 'PGMoney where pgtype = money

498+instance PGTyped 'PGText where pgtype = text

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

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

501+instance PGTyped 'PGBytea where pgtype = bytea

502+instance PGTyped 'PGTimestamp where pgtype = timestamp

503+instance PGTyped 'PGTimestampTZ where pgtype = timestampWithTimeZone

504+instance PGTyped 'PGDate where pgtype = date

505+instance PGTyped 'PGTime where pgtype = time

506+instance PGTyped 'PGTimeTZ where pgtype = timeWithTimeZone

507+instance PGTyped 'PGInterval where pgtype = interval

508+instance PGTyped 'PGUuid where pgtype = uuid

509+instance PGTyped 'PGJson where pgtype = json

510+instance PGTyped 'PGJsonb where pgtype = jsonb

511+

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

512{-----------------------------------------

383statements

513statements

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

514-----------------------------------------}

@@ -588,137 +718,11 @@ subselect selection = join (Subselect selection)

588CREATE statements

718CREATE statements

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

719-----------------------------------------}

590

720

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

721createTable

718 :: (KnownSymbol table, SListI columns)

722 :: (KnownSymbol table, SListI columns)

719 => Alias table

723 => Alias table

720 -> NP (Aliased TypeExpression) columns

724 -> NP (Aliased TypeExpression) columns

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

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

722createTable (Alias table) columns = UnsafeStatement $ mconcat

726createTable (Alias table) columns = UnsafeStatement $ mconcat

723 [ "CREATE TABLE "

727 [ "CREATE TABLE "

724 , fromString $ symbolVal' table

728 , fromString $ symbolVal' table

@@ -780,7 +784,7 @@ addColumnDefault

780 :: KnownSymbol column

784 :: KnownSymbol column

781 => Alias column

785 => Alias column

782 -> TypeExpression ('Optional ty)

786 -> TypeExpression ('Optional ty)

783− -> AlterTable columns ((column ::: 'Optional ty) ': columns)

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

784addColumnDefault (Alias column) ty = UnsafeAlterTable $

788addColumnDefault (Alias column) ty = UnsafeAlterTable $

785 "ADD COLUMN "

789 "ADD COLUMN "

786 <> fromString (symbolVal' column)

790 <> fromString (symbolVal' column)

@@ -1026,7 +1030,7 @@ DELETE statements

1026-----------------------------------------}

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

1027

1031

1028deleteFrom

1032deleteFrom

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

1033+ :: HasTable table schema columns

1030 => Alias table

1034 => Alias table

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

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

1032 -> Statement params '[] schema schema

1036 -> Statement params '[] schema schema