6cb5916 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

create drop and query views

6cb5916Eitan Chatav9 years ago

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+29−9

compare with dev

unifiedsplit

@@ -64,6 +64,9 @@ module Squeal.PostgreSQL.Definition

64 , setNotNull

65 , dropNotNull

66 , alterType

67+ -- * Views

68+ , createView

69+ , dropView

67 ) where

70 ) where

69import Control.Category

72import Control.Category

@@ -77,6 +80,7 @@ import qualified Generics.SOP as SOP

77import qualified GHC.Generics as GHC

80import qualified GHC.Generics as GHC

79import Squeal.PostgreSQL.Expression

82import Squeal.PostgreSQL.Expression

83+import Squeal.PostgreSQL.Query

80import Squeal.PostgreSQL.Render

84import Squeal.PostgreSQL.Render

81import Squeal.PostgreSQL.Schema

85import Squeal.PostgreSQL.Schema

@@ -122,8 +126,8 @@ createTable

122 -> NP (Aliased (TableConstraintExpression schema1 table)) constraints

126 -> NP (Aliased (TableConstraintExpression schema1 table)) constraints

123 -- ^ constraints that must hold for the table

127 -- ^ constraints that must hold for the table

124 -> Definition schema0 schema1

128 -> Definition schema0 schema1

125−createTable table columns constraints = UnsafeDefinition $

129+createTable tab columns constraints = UnsafeDefinition $

126− "CREATE TABLE" <+> renderCreation table columns constraints

130+ "CREATE TABLE" <+> renderCreation tab columns constraints

127

131

128-- | `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.

132-- | `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.

129-- Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.

133-- Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.

@@ -147,9 +151,9 @@ createTableIfNotExists

147 -> NP (Aliased (TableConstraintExpression schema table)) constraints

151 -> NP (Aliased (TableConstraintExpression schema table)) constraints

148 -- ^ constraints that must hold for the table

152 -- ^ constraints that must hold for the table

149 -> Definition schema schema

153 -> Definition schema schema

150−createTableIfNotExists table columns constraints = UnsafeDefinition $

154+createTableIfNotExists tab columns constraints = UnsafeDefinition $

151 "CREATE TABLE IF NOT EXISTS"

155 "CREATE TABLE IF NOT EXISTS"

152− <+> renderCreation table columns constraints

156+ <+> renderCreation tab columns constraints

153

157

154-- helper function for `createTable` and `createTableIfNotExists`

158-- helper function for `createTable` and `createTableIfNotExists`

155renderCreation

159renderCreation

@@ -162,7 +166,7 @@ renderCreation

162 -> NP (Aliased (TableConstraintExpression schema table)) constraints

166 -> NP (Aliased (TableConstraintExpression schema table)) constraints

163 -- ^ constraints that must hold for the table

167 -- ^ constraints that must hold for the table

164 -> ByteString

168 -> ByteString

165−renderCreation table columns constraints = renderAlias table

169+renderCreation tab columns constraints = renderAlias tab

166 <+> parenthesized

170 <+> parenthesized

167 ( renderCommaSeparated renderColumnDef columns

171 ( renderCommaSeparated renderColumnDef columns

168 <> ( case constraints of

172 <> ( case constraints of

@@ -453,10 +457,10 @@ DROP statements

453-- >>> renderDefinition $ dropTable #muh_table

457-- >>> renderDefinition $ dropTable #muh_table

454-- "DROP TABLE \"muh_table\";"

458-- "DROP TABLE \"muh_table\";"

455dropTable

459dropTable

456− :: KnownSymbol table

460+ :: Has table schema ('Table t)

457 => Alias table -- ^ table to remove

461 => Alias table -- ^ table to remove

458 -> Definition schema (Drop table schema)

462 -> Definition schema (Drop table schema)

459−dropTable table = UnsafeDefinition $ "DROP TABLE" <+> renderAlias table <> ";"

463+dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderAlias tab <> ";"

460

464

461{-----------------------------------------

465{-----------------------------------------

462ALTER statements

466ALTER statements

@@ -468,9 +472,9 @@ alterTable

468 => Alias alias -- ^ table to alter

472 => Alias alias -- ^ table to alter

469 -> AlterTable alias table schema -- ^ alteration to perform

473 -> AlterTable alias table schema -- ^ alteration to perform

470 -> Definition schema (Alter alias ('Table table) schema)

474 -> Definition schema (Alter alias ('Table table) schema)

471−alterTable table alteration = UnsafeDefinition $

475+alterTable tab alteration = UnsafeDefinition $

472 "ALTER TABLE"

476 "ALTER TABLE"

473− <+> renderAlias table

477+ <+> renderAlias tab

474 <+> renderAlterTable alteration

478 <+> renderAlterTable alteration

475 <> ";"

479 <> ";"

476

480

@@ -731,3 +735,19 @@ dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

731-- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" TYPE numeric NOT NULL;"

735-- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" TYPE numeric NOT NULL;"

732alterType :: TypeExpression ty -> AlterColumn ty0 ty

736alterType :: TypeExpression ty -> AlterColumn ty0 ty

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

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

738+

739+createView

740+ :: KnownSymbol view

741+ => Alias view -- ^ the name of the table to add

742+ -> Query schema '[] relation

743+ -- ^ query

744+ -> Definition schema (Create view ('View relation) schema)

745+createView alias query = UnsafeDefinition $

746+ "CREATE" <+> "VIEW" <+> renderAlias alias <+> "AS"

747+ <+> renderQuery query <> ";"

748+

749+dropView

750+ :: Has view schema ('View v)

751+ => Alias view -- ^ view to remove

752+ -> Definition schema (Drop view schema)

753+dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+13

@@ -99,6 +99,7 @@ module Squeal.PostgreSQL.Expression

99 , max_, maxDistinct, min_, minDistinct

100 -- * Tables

101 , Table (UnsafeTable, renderTable)

102+ , View (UnsafeView, renderView)

102 -- * Types

103 -- * Types

103 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

104 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

104 , PGTyped (pgtype)

105 , PGTyped (pgtype)

@@ -1036,6 +1037,18 @@ instance

1036 ) => IsLabel alias (Table schema relation) where

1037 ) => IsLabel alias (Table schema relation) where

1037 fromLabel = UnsafeTable $ renderAlias (Alias @alias)

1038 fromLabel = UnsafeTable $ renderAlias (Alias @alias)

1038

1039

1040+-- | A `View` from a table expression is a way

1041+-- to call a table reference by its alias.

1042+newtype View

1043+ (schema :: SchemaType)

1044+ (columns :: RelationType)

1045+ = UnsafeView { renderView :: ByteString }

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

1047+instance

1048+ ( Has alias (ViewsOf schema) columns

1049+ ) => IsLabel alias (View schema columns) where

1050+ fromLabel = UnsafeView $ renderAlias (Alias @alias)

1051+

1039{-----------------------------------------

1052{-----------------------------------------

1040type expressions

1053type expressions

1041-----------------------------------------}

1054-----------------------------------------}

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+7

@@ -58,6 +58,7 @@ module Squeal.PostgreSQL.Query

58 , FromClause (..)

59 , table

60 , subquery

61+ , view

61 , crossJoin

62 , crossJoin

62 , innerJoin

63 , innerJoin

63 , leftOuterJoin

64 , leftOuterJoin

@@ -612,6 +613,12 @@ subquery

612 -> FromClause schema params '[table]

613 -> FromClause schema params '[table]

613subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)

614subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)

614

615

616+-- | `view` derives a table from a `View`.

617+view

618+ :: Aliased (View schema) table

619+ -> FromClause schema params '[table]

620+view = UnsafeFromClause . renderAliasedAs renderView

621+

615{- | @left & crossJoin right@. For every possible combination of rows from

622{- | @left & crossJoin right@. For every possible combination of rows from

616 @left@ and @right@ (i.e., a Cartesian product), the joined table will contain

623 @left@ and @right@ (i.e., a Cartesian product), the joined table will contain

617 a row consisting of all columns in @left@ followed by all columns in @right@.

624 a row consisting of all columns in @left@ followed by all columns in @right@.