8d840c2 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

CREATE & DROP TABLE statements

8d840c2Eitan Chatav9 years ago

squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+25

compare with dev

unifiedsplit

@@ -348,3 +348,28 @@ insertInto (Alias table) expressions = UnsafeQuery $ "INSERT INTO "

348 values = recordToList $ rmap

349 (\ (expression `As` _) -> Const (renderExpression expression))

350 expressions

351+

352+createTable

353+ :: (KnownSymbol table, KnownColumns columns)

354+ => Alias table

355+ -> Proxy# columns

356+ -> Query '[] schema ((table ::: columns) ': schema) '[]

357+createTable (Alias table) columns = UnsafeQuery $ mconcat

358+ [ "CREATE TABLE "

359+ , fromString $ symbolVal' table

360+ , " ("

361+ , renderColumns columns

362+ , ");"

363+ ]

364+

365+class KnownSymbol table => DropTable table schema0 schema1

366+ | table schema0 -> schema1 where

367+ dropTable :: Alias table -> Query '[] schema0 schema1 '[]

368+ dropTable (Alias table) = UnsafeQuery $

369+ "DROP TABLE " <> fromString (symbolVal' table) <> ";"

370+instance {-# OVERLAPPING #-}

371+ (KnownSymbol table, table ~ table')

372+ => DropTable table ((table' ::: columns) ': schema) schema

373+instance {-# OVERLAPPABLE #-}

374+ (KnownSymbol table, DropTable table schema0 schema1)

375+ => DropTable table (tabCols ': schema0) (tabCols ': schema1)

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

@@ -1,5 +1,6 @@

1{-# LANGUAGE

2 DataKinds

3+ , FlexibleContexts

3 , FlexibleInstances

4 , FlexibleInstances

4 , GADTs

5 , GADTs

5 , MagicHash

6 , MagicHash

@@ -19,6 +20,8 @@ module Squeel.PostgreSQL.Schema

19 , (:::)

20 , (:::)

20 , Alias (Alias)

21 , Alias (Alias)

21 , Aliased (As)

22 , Aliased (As)

23+ , KnownPGType (..)

24+ , KnownColumns (..)

22 , renderAliased

25 , renderAliased

23 , module GHC.OverloadedLabels

26 , module GHC.OverloadedLabels

24 , module GHC.TypeLits

27 , module GHC.TypeLits

@@ -97,3 +100,58 @@ renderAliased

97 -> ByteString

100 -> ByteString

98renderAliased render (expression `As` Alias alias) =

101renderAliased render (expression `As` Alias alias) =

99 render expression <> " AS " <> fromString (symbolVal' alias)

102 render expression <> " AS " <> fromString (symbolVal' alias)

103+

104+class KnownPGType (ty :: PGType) where

105+ renderPGType :: Proxy# ty -> ByteString

106+instance KnownPGType 'PGBool where renderPGType _ = "bool"

107+instance KnownPGType 'PGInt2 where renderPGType _ = "int2"

108+instance KnownPGType 'PGInt4 where renderPGType _ = "int4"

109+instance KnownPGType 'PGInt8 where renderPGType _ = "int8"

110+instance KnownPGType 'PGNumeric where renderPGType _ = "numeric"

111+instance KnownPGType 'PGFloat4 where renderPGType _ = "float4"

112+instance KnownPGType 'PGFloat8 where renderPGType _ = "float8"

113+instance KnownPGType 'PGSerial2 where renderPGType _ = "serial2"

114+instance KnownPGType 'PGSerial4 where renderPGType _ = "serial4"

115+instance KnownPGType 'PGSerial8 where renderPGType _ = "serial8"

116+instance KnownPGType 'PGMoney where renderPGType _ = "money"

117+instance KnownNat n => KnownPGType ('PGChar n) where

118+ renderPGType _ = "char("

119+ <> fromString (show (natVal' (proxy# :: Proxy# n)))

120+ <> ")"

121+instance KnownNat n => KnownPGType ('PGVarChar n) where

122+ renderPGType _ = "varchar("

123+ <> fromString (show (natVal' (proxy# :: Proxy# n)))

124+ <> ")"

125+instance KnownPGType 'PGText where renderPGType _ = "text"

126+instance KnownPGType 'PGBytea where renderPGType _ = "bytea"

127+instance KnownPGType 'PGTimestamp where renderPGType _ = "timestamp"

128+instance KnownPGType 'PGTimestampTZ where renderPGType _ = "timestampTZ"

129+instance KnownPGType 'PGDate where renderPGType _ = "date"

130+instance KnownPGType 'PGTime where renderPGType _ = "time"

131+instance KnownPGType 'PGTimeTZ where renderPGType _ = "timeTZ"

132+instance KnownPGType 'PGInterval where renderPGType _ = "interval"

133+instance KnownPGType 'PGUuid where renderPGType _ = "uuid"

134+instance KnownPGType 'PGJson where renderPGType _ = "json"

135+instance KnownPGType 'PGJsonb where renderPGType _ = "jsonb"

136+

137+class KnownColumns (columns :: [(Symbol,PGType)]) where

138+ renderColumns :: Proxy# columns -> ByteString

139+instance

140+ ( KnownSymbol column

141+ , KnownPGType ty

142+ ) => KnownColumns '[column ::: ty] where

143+ renderColumns _ =

144+ fromString (symbolVal' (proxy# :: Proxy# column))

145+ <> " "

146+ <> renderPGType (proxy# :: Proxy# ty)

147+instance

148+ ( KnownSymbol column

149+ , KnownPGType ty

150+ , KnownColumns (columnsHead ': columnsTail)

151+ ) => KnownColumns ((column ::: ty) ': columnsHead ': columnsTail) where

152+ renderColumns _ =

153+ fromString (symbolVal' (proxy# :: Proxy# column))

154+ <> " "

155+ <> renderPGType (proxy# :: Proxy# ty)

156+ <> ", "

157+ <> renderColumns (proxy# :: Proxy# (columnsHead ': columnsTail))

squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+14−1

@@ -1,8 +1,8 @@

1{-# LANGUAGE

2 DataKinds

3+ , MagicHash

3 , OverloadedLabels

4 , OverloadedLabels

4 , OverloadedStrings

5 , OverloadedStrings

5− , PolyKinds

6 , TypeOperators

7#-}

@@ -11,6 +11,7 @@ module Squeel.PostgreSQL.QuerySpec where

11import Data.Boolean

12import Data.Function

13import Data.Vinyl

14+import GHC.Exts

14import Test.Hspec

15import Test.Hspec

16import Squeel.PostgreSQL.Query

17import Squeel.PostgreSQL.Query

@@ -122,6 +123,18 @@ spec = do

122 \ ON (orders.customerID = customers.customerID)\

123 \ ON (orders.customerID = customers.customerID)\

123 \ INNER JOIN shippers\

124 \ INNER JOIN shippers\

124 \ ON (orders.shipperID = shippers.shipperID);"

125 \ ON (orders.shipperID = shippers.shipperID);"

126+ it "should render simple CREATE TABLE statements" $ do

127+ let

128+ statement :: Query '[] '[] Tables '[]

129+ statement = createTable #table1 (proxy# :: Proxy# Columns)

130+ statement `shouldRenderAs`

131+ "CREATE TABLE table1 (col1 int4, col2 int4);"

132+ it "should render DROP TABLE statements" $ do

133+ let

134+ statement :: Query '[] Tables '[] '[]

135+ statement = dropTable #table1

136+ statement `shouldRenderAs`

137+ "DROP TABLE table1;"

125

138

126type Columns = '[ "col1" ::: 'PGInt4, "col2" ::: 'PGInt4]

139type Columns = '[ "col1" ::: 'PGInt4, "col2" ::: 'PGInt4]

127type Tables = '[ "table1" ::: Columns ]

140type Tables = '[ "table1" ::: Columns ]