ddc9847 · squeal · git.iko.soy

git.iko.soy/squeal

Merge pull request #168 from morphismtech/dev-type-expr

move type things around

commitddc9847ab57fe92d5a4c459b2a26f710a3e2f138 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 1 Nov 2019, 19:53 (7 years ago) parentb63086c 4b59f52

7 files changed+96−139

unifiedsplit

squeal-postgresql/squeal-postgresql.cabal−1 squeal-postgresql/src/Squeal/PostgreSQL.hs−1 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs−26 squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hs−105 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+95−4 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−1

squeal-postgresql/squeal-postgresql.cabal−1

@@ -28,7 +28,6 @@ library

2828 Squeal.PostgreSQL.Definition.Function

2929 Squeal.PostgreSQL.Definition.Index

3030 Squeal.PostgreSQL.Definition.Table

31− Squeal.PostgreSQL.Definition.Table.Column

3231 Squeal.PostgreSQL.Definition.Table.Constraint

3332 Squeal.PostgreSQL.Definition.Type

3433 Squeal.PostgreSQL.Definition.Schema

squeal-postgresql/src/Squeal/PostgreSQL.hs−1

@@ -199,7 +199,6 @@ import Squeal.PostgreSQL.Definition.Function as X

199199import Squeal.PostgreSQL.Definition.Index as X

200200import Squeal.PostgreSQL.Definition.Schema as X

201201import Squeal.PostgreSQL.Definition.Table as X

202−import Squeal.PostgreSQL.Definition.Table.Column as X

203202import Squeal.PostgreSQL.Definition.Table.Constraint as X

204203import Squeal.PostgreSQL.Definition.Type as X

205204import Squeal.PostgreSQL.Definition.View as X

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs−26

@@ -35,8 +35,6 @@ module Squeal.PostgreSQL.Definition

3535 Definition (..)

3636 , (>>>)

3737 , manipDefinition

38− , PGNullityTyped (..)

39− , hask

4038 ) where

4139

4240import Control.Category

@@ -47,10 +45,7 @@ import Prelude hiding ((.), id)

4745

4846import qualified GHC.Generics as GHC

4947

50−import Squeal.PostgreSQL.Definition.Table.Column

51−import Squeal.PostgreSQL.Expression.Type

5248import Squeal.PostgreSQL.Manipulation

53−import Squeal.PostgreSQL.PG

5449import Squeal.PostgreSQL.Render

5550import Squeal.PostgreSQL.Schema

5651

@@ -85,24 +80,3 @@ manipDefinition

8580 -- ^ no input or output

8681 -> Definition schemas schemas

8782manipDefinition = UnsafeDefinition . (<> ";") . renderSQL

88−

89−-- | Like @PGTyped@ but also accounts for nullity.

90−class PGNullityTyped schemas (nullty :: NullityType) where

91− pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)

92−

93−instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where

94− pgNullityType = nullable (pgtype @_ @('Null ty))

95−

96−instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where

97− pgNullityType = notNullable (pgtype @_ @('NotNull ty))

98−

99−-- | Allow you to specify pg column types in relation to haskell types.

100−-- >>> printSQL $ hask @(Maybe String)

101−-- text NULL

102−--

103−-- >>> printSQL $ hask @Double

104−-- float8 NOT NULL

105−hask

106− :: forall h schemas. PGNullityTyped schemas (NullPG h)

107− => ColumnTypeExpression schemas ('NoDef :=> NullPG h)

108−hask = pgNullityType

squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs+1−1

@@ -62,9 +62,9 @@ import qualified GHC.Generics as GHC

6262

6363import Squeal.PostgreSQL.Alias

6464import Squeal.PostgreSQL.Definition

65−import Squeal.PostgreSQL.Definition.Table.Column

6665import Squeal.PostgreSQL.Definition.Table.Constraint

6766import Squeal.PostgreSQL.Expression

67+import Squeal.PostgreSQL.Expression.Type

6868import Squeal.PostgreSQL.List

6969import Squeal.PostgreSQL.Render

7070import Squeal.PostgreSQL.Schema

squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hsdeleted−105

@@ -1,105 +0,0 @@

1−{-|

2−Module: Squeal.PostgreSQL.Definition.Table.Column

3−Description: Column type expressions

4−Copyright: (c) Eitan Chatav, 2017

5−Maintainer: eitan@morphism.tech

6−Stability: experimental

7−

8−Column type expressions.

9−-}

10−

11−{-# LANGUAGE

12− AllowAmbiguousTypes

13− , ConstraintKinds

14− , DeriveAnyClass

15− , DeriveGeneric

16− , DerivingStrategies

17− , FlexibleContexts

18− , FlexibleInstances

19− , GADTs

20− , LambdaCase

21− , MultiParamTypeClasses

22− , OverloadedLabels

23− , OverloadedStrings

24− , RankNTypes

25− , ScopedTypeVariables

26− , TypeApplications

27− , TypeInType

28− , TypeOperators

29− , UndecidableSuperClasses

30−#-}

31−

32−module Squeal.PostgreSQL.Definition.Table.Column

33− ( ColumnTypeExpression (..)

34− , nullable

35− , notNullable

36− , default_

37− , serial2

38− , smallserial

39− , serial4

40− , serial

41− , serial8

42− , bigserial

43− ) where

44−

45−import Control.DeepSeq

46−import Data.ByteString

47−

48−import qualified GHC.Generics as GHC

49−

50−import Squeal.PostgreSQL.Alias

51−import Squeal.PostgreSQL.Expression

52−import Squeal.PostgreSQL.Expression.Type

53−import Squeal.PostgreSQL.Render

54−import Squeal.PostgreSQL.Schema

55−

56−-- $setup

57−-- >>> import Squeal.PostgreSQL

58−

59−-- | `ColumnTypeExpression`s are used in `createTable` commands.

60−newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)

61− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }

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

63−instance RenderSQL (ColumnTypeExpression schemas ty) where

64− renderSQL = renderColumnTypeExpression

65−

66−-- | used in `createTable` commands as a column constraint to note that

67−-- @NULL@ may be present in a column

68−nullable

69− :: TypeExpression schemas (nullity ty)

70− -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)

71−nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"

72−

73−-- | used in `createTable` commands as a column constraint to ensure

74−-- @NULL@ is not present in a column

75−notNullable

76− :: TypeExpression schemas (nullity ty)

77− -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)

78−notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"

79−

80−-- | used in `createTable` commands as a column constraint to give a default

81−default_

82− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty

83− -> ColumnTypeExpression schemas ('NoDef :=> ty)

84− -> ColumnTypeExpression schemas ('Def :=> ty)

85−default_ x ty = UnsafeColumnTypeExpression $

86− renderSQL ty <+> "DEFAULT" <+> renderExpression x

87−

88−-- | not a true type, but merely a notational convenience for creating

89−-- unique identifier columns with type `PGint2`

90−serial2, smallserial

91− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)

92−serial2 = UnsafeColumnTypeExpression "serial2"

93−smallserial = UnsafeColumnTypeExpression "smallserial"

94−-- | not a true type, but merely a notational convenience for creating

95−-- unique identifier columns with type `PGint4`

96−serial4, serial

97− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)

98−serial4 = UnsafeColumnTypeExpression "serial4"

99−serial = UnsafeColumnTypeExpression "serial"

100−-- | not a true type, but merely a notational convenience for creating

101−-- unique identifier columns with type `PGint8`

102−serial8, bigserial

103− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)

104−serial8 = UnsafeColumnTypeExpression "serial8"

105−bigserial = UnsafeColumnTypeExpression "bigserial"

squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+95−4

@@ -23,15 +23,16 @@ Type expressions.

2323 , ScopedTypeVariables

2424 , TypeApplications

2525 , TypeOperators

26+ , UndecidableInstances

2627#-}

2728

2829module Squeal.PostgreSQL.Expression.Type

29− ( TypeExpression (..)

30− , cast

30+ ( -- * type casting

31+ cast

3132 , astype

3233 , inferredtype

33− , PGTyped (..)

34− , FieldTyped (..)

34+ -- * type expressions

35+ , TypeExpression (..)

3536 , typedef

3637 , typetable

3738 , typeview

@@ -78,6 +79,22 @@ module Squeal.PostgreSQL.Expression.Type

7879 , tsrange

7980 , tstzrange

8081 , daterange

82+ -- * column type definitions

83+ , ColumnTypeExpression (..)

84+ , nullable

85+ , notNullable

86+ , default_

87+ , serial2

88+ , smallserial

89+ , serial4

90+ , serial

91+ , serial8

92+ , bigserial

93+ , hask

94+ -- * type inference

95+ , PGTyped (..)

96+ , PGNullityTyped (..)

97+ , FieldTyped (..)

8198 ) where

8299

83100import Control.DeepSeq

@@ -91,6 +108,7 @@ import qualified Generics.SOP as SOP

91108

92109import Squeal.PostgreSQL.Alias

93110import Squeal.PostgreSQL.Expression

111+import Squeal.PostgreSQL.PG

94112import Squeal.PostgreSQL.Render

95113import Squeal.PostgreSQL.Schema

96114

@@ -132,6 +150,7 @@ astype = cast

132150inferredtype

133151 :: PGTyped schemas ty

134152 => Expression outer common grp schemas params from ty

153+ -- ^ value

135154 -> Expression outer common grp schemas params from ty

136155inferredtype = astype pgtype

137156

@@ -151,6 +170,7 @@ instance RenderSQL (TypeExpression schemas ty) where

151170typedef

152171 :: (Has sch schemas schema, Has td schema ('Typedef ty))

153172 => QualifiedAlias sch td

173+ -- ^ type alias

154174 -> TypeExpression schemas (null ty)

155175typedef = UnsafeTypeExpression . renderSQL

156176

@@ -159,6 +179,7 @@ typedef = UnsafeTypeExpression . renderSQL

159179typetable

160180 :: (Has sch schemas schema, Has tab schema ('Table table))

161181 => QualifiedAlias sch tab

182+ -- ^ table alias

162183 -> TypeExpression schemas (null ('PGcomposite (TableToRow table)))

163184typetable = UnsafeTypeExpression . renderSQL

164185

@@ -167,6 +188,7 @@ typetable = UnsafeTypeExpression . renderSQL

167188typeview

168189 :: (Has sch schemas schema, Has vw schema ('View view))

169190 => QualifiedAlias sch vw

191+ -- ^ view alias

170192 -> TypeExpression schemas (null ('PGcomposite view))

171193typeview = UnsafeTypeExpression . renderSQL

172194

@@ -353,3 +375,72 @@ class FieldTyped schemas ty where

353375instance (KnownSymbol alias, PGTyped schemas ty)

354376 => FieldTyped schemas (alias ::: ty) where

355377 fieldtype = pgtype `As` Alias

378+

379+-- | `ColumnTypeExpression`s are used in `createTable` commands.

380+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)

381+ = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }

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

383+instance RenderSQL (ColumnTypeExpression schemas ty) where

384+ renderSQL = renderColumnTypeExpression

385+

386+-- | used in `createTable` commands as a column constraint to note that

387+-- @NULL@ may be present in a column

388+nullable

389+ :: TypeExpression schemas (nullity ty)

390+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)

391+nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"

392+

393+-- | used in `createTable` commands as a column constraint to ensure

394+-- @NULL@ is not present in a column

395+notNullable

396+ :: TypeExpression schemas (nullity ty)

397+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)

398+notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"

399+

400+-- | used in `createTable` commands as a column constraint to give a default

401+default_

402+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty

403+ -> ColumnTypeExpression schemas ('NoDef :=> ty)

404+ -> ColumnTypeExpression schemas ('Def :=> ty)

405+default_ x ty = UnsafeColumnTypeExpression $

406+ renderSQL ty <+> "DEFAULT" <+> renderExpression x

407+

408+-- | not a true type, but merely a notational convenience for creating

409+-- unique identifier columns with type `PGint2`

410+serial2, smallserial

411+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)

412+serial2 = UnsafeColumnTypeExpression "serial2"

413+smallserial = UnsafeColumnTypeExpression "smallserial"

414+-- | not a true type, but merely a notational convenience for creating

415+-- unique identifier columns with type `PGint4`

416+serial4, serial

417+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)

418+serial4 = UnsafeColumnTypeExpression "serial4"

419+serial = UnsafeColumnTypeExpression "serial"

420+-- | not a true type, but merely a notational convenience for creating

421+-- unique identifier columns with type `PGint8`

422+serial8, bigserial

423+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)

424+serial8 = UnsafeColumnTypeExpression "serial8"

425+bigserial = UnsafeColumnTypeExpression "bigserial"

426+

427+-- | Like @PGTyped@ but also accounts for nullity.

428+class PGNullityTyped schemas (nullty :: NullityType) where

429+ pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)

430+

431+instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where

432+ pgNullityType = nullable (pgtype @_ @('Null ty))

433+

434+instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where

435+ pgNullityType = notNullable (pgtype @_ @('NotNull ty))

436+

437+-- | Allow you to specify pg column types in relation to haskell types.

438+-- >>> printSQL $ hask @(Maybe String)

439+-- text NULL

440+--

441+-- >>> printSQL $ hask @Double

442+-- float8 NOT NULL

443+hask

444+ :: forall hask schemas. PGNullityTyped schemas (NullPG hask)

445+ => ColumnTypeExpression schemas ('NoDef :=> NullPG hask)

446+hask = pgNullityType

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−1

@@ -168,7 +168,6 @@ import Squeal.PostgreSQL.Alias

168168import Squeal.PostgreSQL.Binary

169169import Squeal.PostgreSQL.Definition

170170import Squeal.PostgreSQL.Definition.Table

171−import Squeal.PostgreSQL.Definition.Table.Column

172171import Squeal.PostgreSQL.Definition.Table.Constraint

173172import Squeal.PostgreSQL.Expression.Comparison

174173import Squeal.PostgreSQL.Expression.Parameter