dd96a8b · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

try to fix test errors

dd96a8bEitan Chatav8 years ago

squeal-postgresql/src/Squeal/PostgreSQL.hs+21−22

compare with dev

unifiedsplit

@@ -32,26 +32,25 @@ The first step is to define the schema of our database. This is where

32we use @DataKinds@ and @TypeOperators@.

34>>> :{

35+type UsersColumns =

36+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4

37+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext ]

38+type UsersConstraints = '[ "pk_users" ::: 'PrimaryKey '["id"] ]

39+type EmailsColumns =

40+ '[ "pk_emails" ::: 'PrimaryKey '["id"]

41+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"] ]

42+type EmailsConstraints =

43+ '[ "pk_emails" ::: 'PrimaryKey '["id"]

44+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"] ]

35type Schema =

45type Schema =

36− '[ "users" ::: 'Table (

46+ '[ "users" ::: 'Table (UsersConstraints :=> UsersColumns)

37− '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>

38− '[ "id" ::: 'Def :=> 'NotNull 'PGint4

39− , "name" ::: 'NoDef :=> 'NotNull 'PGtext

40− ])

41− , "emails" ::: 'Table (

47+ , "emails" ::: 'Table (EmailsConstraints :=> EmailsColumns) ]

42− '[ "pk_emails" ::: 'PrimaryKey '["id"]

48+type DB = '[ "public" ::: Schema ]

43− , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]

44− ] :=>

45− '[ "id" ::: 'Def :=> 'NotNull 'PGint4

46− , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4

47− , "email" ::: 'NoDef :=> 'Null 'PGtext

48− ])

49− ]

50:}

49:}

52Notice the use of type operators.

51Notice the use of type operators.

54−`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `SchemumType`,

53+`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `DBType`, a `SchemumType`,

55a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's @::@

54a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's @::@

56operator.

55operator.

@@ -68,7 +67,7 @@ labels to refer to named tables and columns in our schema.

69>>> :{

68>>> :{

70let

69let

71− setup :: Definition '[] Schema

70+ setup :: Definition '["public" ::: '[]] DB

72 setup =

71 setup =

73 createTable #users

72 createTable #users

74 ( serial `as` #id :*

73 ( serial `as` #id :*

@@ -89,14 +88,14 @@ We can easily see the generated SQL is unsurprising looking.

89CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));

88CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));

90CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);

89CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);

92−Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.

91+Notice that @setup@ starts with an empty public schema @'["public" ::: '[]]@ and produces @DB@.

93In our `createTable` commands we included `TableConstraint`s to define

92In our `createTable` commands we included `TableConstraint`s to define

94primary and foreign keys, making them somewhat complex. Our @teardown@

93primary and foreign keys, making them somewhat complex. Our @teardown@

95`Definition` is simpler.

94`Definition` is simpler.

97>>> :{

96>>> :{

98let

97let

99− teardown :: Definition Schema '[]

98+ teardown :: Definition DB '["public" ::: '[]]

100 teardown = dropTable #emails >>> dropTable #users

99 teardown = dropTable #emails >>> dropTable #users

101:}

100:}

102

101

@@ -117,7 +116,7 @@ of our inserts.

117

116

118>>> :{

117>>> :{

119let

118let

120− insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]

119+ insertUser :: Manipulation DB '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]

121 insertUser = insertRow #users

120 insertUser = insertRow #users

122 (Default `as` #id :* Set (param @1) `as` #name)

121 (Default `as` #id :* Set (param @1) `as` #name)

123 OnConflictDoNothing (Returning (#id `as` #fromOnly))

122 OnConflictDoNothing (Returning (#id `as` #fromOnly))

@@ -125,7 +124,7 @@ let

125

124

126>>> :{

125>>> :{

127let

126let

128− insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]

127+ insertEmail :: Manipulation DB '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]

129 insertEmail = insertRow #emails

128 insertEmail = insertRow #emails

130 ( Default `as` #id :*

129 ( Default `as` #id :*

131 Set (param @1) `as` #user_id :*

130 Set (param @1) `as` #user_id :*

@@ -145,7 +144,7 @@ need to use an inner join to get the right result. A `Query` is like a

145

144

146>>> :{

145>>> :{

147let

146let

148− getUsers :: Query Schema '[]

147+ getUsers :: Query DB '[]

149 '[ "userName" ::: 'NotNull 'PGtext

148 '[ "userName" ::: 'NotNull 'PGtext

150 , "userEmail" ::: 'Null 'PGtext ]

149 , "userEmail" ::: 'Null 'PGtext ]

151 getUsers = select

150 getUsers = select

@@ -190,7 +189,7 @@ transformer and when the schema doesn't change we can use `Monad` and

190

189

191>>> :{

190>>> :{

192let

191let

193− session :: PQ Schema Schema IO ()

192+ session :: PQ DB DB IO ()

194 session = do

193 session = do

195 idResults <- traversePrepared insertUser (Only . userName <$> users)

194 idResults <- traversePrepared insertUser (Only . userName <$> users)

196 ids <- traverse (fmap fromOnly . getRow 0) idResults

195 ids <- traverse (fmap fromOnly . getRow 0) idResults

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+8−6

@@ -244,7 +244,7 @@ class KnownNat n => HasParameter

244 | n params -> ty where

245 -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.

246 --

247− -- >>> let expr = parameter @1 int4 :: Expression sch rels grp '[ 'Null 'PGint4] ('Null 'PGint4)

247+ -- >>> let expr = parameter @1 int4 :: Expression db from grp '[ 'Null 'PGint4] ('Null 'PGint4)

248 -- >>> printSQL expr

249 -- ($1 :: int4)

250 parameter

@@ -260,7 +260,7 @@ instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) db params ty)

260-- | `param` takes a `Nat` using type application and for basic types,

261-- infers a `TypeExpression`.

262--

263−-- >>> let expr = param @1 :: Expression sch rels grp '[ 'Null 'PGint4] ('Null 'PGint4)

263+-- >>> let expr = param @1 :: Expression db from grp '[ 'Null 'PGint4] ('Null 'PGint4)

264-- >>> printSQL expr

265-- ($1 :: int4)

266param

@@ -419,7 +419,7 @@ matchNull y f x = ifThenElse (isNull x) y

419`nullIf` gives @NULL@.

420

421>>> :set -XTypeApplications -XDataKinds

422−>>> let expr = nullIf false (param @1) :: Expression db rels grp '[ 'NotNull 'PGbool] ('Null 'PGbool)

422+>>> let expr = nullIf false (param @1) :: Expression db from grp '[ 'NotNull 'PGbool] ('Null 'PGbool)

423>>> printSQL expr

424NULL IF (FALSE, ($1 :: bool))

425-}

@@ -463,7 +463,7 @@ instance (KnownSymbol label, label `In` labels) => IsPGlabel label

463-- , "imaginary" ::: 'NotNull 'PGfloat8 ]

464-- :}

465--

466−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex)

466+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression db from grp params ('NotNull Complex)

467-- >>> printSQL i

468-- ROW(0, 1)

469row

@@ -478,11 +478,13 @@ row exprs = UnsafeExpression $ "ROW" <> parenthesized

478-- type Complex = 'PGcomposite

479-- '[ "real" ::: 'NotNull 'PGfloat8

480-- , "imaginary" ::: 'NotNull 'PGfloat8 ]

481+-- type Schema = '["complex" ::: 'Typedef Complex]

482+-- type DB = '["public" ::: Schema]

481-- :}

483-- :}

482--

484--

483−-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '["complex" ::: 'Typedef Complex] '[] 'Ungrouped '[] ('NotNull Complex)

485+-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression DB from grp params ('NotNull Complex)

484-- >>> printSQL $ i & field #complex #imaginary

486-- >>> printSQL $ i & field #complex #imaginary

485−-- (ROW(0, 1)::"complex")."imaginary"

487+-- (ROW(0, 1)::"public"."complex")."imaginary"

486field

488field

487 :: ( Has sch db schema

489 :: ( Has sch db schema

488 , Has tydef schema ('Typedef ('PGcomposite row))

490 , Has tydef schema ('Typedef ('PGcomposite row))

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+16−16

@@ -147,7 +147,7 @@ simple query:

147>>> :{

148let

149 query :: Query

150− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]

150+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]

151 '[]

152 '["col" ::: 'Null 'PGint4]

153 query = selectStar (from (table #tab))

@@ -160,9 +160,9 @@ restricted query:

160>>> :{

161let

162 query :: Query

163− '[ "tab" ::: 'Table ('[] :=>

163+ '[ "public" ::: '[ "tab" ::: 'Table ('[] :=>

164 '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

165− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]

165+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]]

166 '[]

167 '[ "sum" ::: 'NotNull 'PGint4

168 , "col1" ::: 'NotNull 'PGint4 ]

@@ -181,7 +181,7 @@ subquery:

181>>> :{

182let

183 query :: Query

184− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]

184+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]

185 '[]

186 '["col" ::: 'Null 'PGint4]

187 query =

@@ -196,7 +196,7 @@ limits and offsets:

196>>> :{

197let

198 query :: Query

199− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]

199+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]

200 '[]

201 '["col" ::: 'Null 'PGint4]

202 query = selectStar

@@ -210,7 +210,7 @@ parameterized query:

210>>> :{

211let

212 query :: Query

213− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGfloat8])]

213+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGfloat8])]]

214 '[ 'NotNull 'PGfloat8]

215 '["col" ::: 'NotNull 'PGfloat8]

216 query = selectStar

@@ -224,9 +224,9 @@ aggregation query:

224>>> :{

225let

226 query :: Query

227− '[ "tab" ::: 'Table ('[] :=>

227+ '["public" ::: '[ "tab" ::: 'Table ('[] :=>

228 '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4

229− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]

229+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]]

230 '[]

231 '[ "sum" ::: 'NotNull 'PGint4

232 , "col1" ::: 'NotNull 'PGint4 ]

@@ -244,7 +244,7 @@ sorted query:

244>>> :{

245let

246 query :: Query

247− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]

247+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]

248 '[]

249 '["col" ::: 'Null 'PGint4]

250 query = selectStar

@@ -259,7 +259,7 @@ joins:

259>>> :{

260let

261 query :: Query

262− '[ "orders" ::: 'Table (

262+ '["public" ::: '[ "orders" ::: 'Table (

263 '["pk_orders" ::: PrimaryKey '["id"]

264 ,"fk_customers" ::: ForeignKey '["customer_id"] "customers" '["id"]

265 ,"fk_shippers" ::: ForeignKey '["shipper_id"] "shippers" '["id"]] :=>

@@ -278,7 +278,7 @@ let

278 '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4

279 , "name" ::: 'NoDef :=> 'NotNull 'PGtext

280 ])

281− ]

281+ ]]

282 '[]

283 '[ "order_price" ::: 'NotNull 'PGfloat4

284 , "customer_name" ::: 'NotNull 'PGtext

@@ -302,7 +302,7 @@ self-join:

302>>> :{

303let

304 query :: Query

305− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]

305+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]

306 '[]

307 '["col" ::: 'Null 'PGint4]

308 query = selectDotStar #t1

@@ -315,7 +315,7 @@ value queries:

315

316>>> :{

317let

318− query :: Query '[] '[] '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

318+ query :: Query db '[] '["foo" ::: 'NotNull 'PGint2, "bar" ::: 'NotNull 'PGbool]

319 query = values (1 `as` #foo :* true `as` #bar) [2 `as` #foo :* false `as` #bar]

320in printSQL query

321:}

@@ -326,7 +326,7 @@ set operations:

326>>> :{

327let

328 query :: Query

329− '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]

329+ '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]

330 '[]

331 '["col" ::: 'Null 'PGint4]

332 query =

@@ -342,9 +342,9 @@ with queries:

342>>> :{

343let

344 query :: Query

345− '[ "t1" ::: 'View

345+ '["public" ::: '[ "t1" ::: 'View

346 '[ "c1" ::: 'NotNull 'PGtext

347− , "c2" ::: 'NotNull 'PGtext] ]

347+ , "c2" ::: 'NotNull 'PGtext] ]]

348 '[]

349 '[ "c1" ::: 'NotNull 'PGtext

350 , "c2" ::: 'NotNull 'PGtext ]

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+6

@@ -480,6 +480,12 @@ instance (q ~ q', a ~ a') => IsQualified q a (QualifiedAlias q' a') where

480 _!_ = QualifiedAlias

481instance (q' ~ "public", a ~ a') => IsLabel a (QualifiedAlias q' a') where

482 fromLabel = QualifiedAlias

483+instance (q ~ q', a ~ a', KnownSymbol a') =>

484+ IsQualified q a (Aliased (QualifiedAlias q') (a' ::: a')) where

485+ _!_ = QualifiedAlias `As` Alias

486+instance (q' ~ "public", a ~ a', KnownSymbol a') =>

487+ IsLabel a (Aliased (QualifiedAlias q') (a' ::: a')) where

488+ fromLabel = QualifiedAlias `As` Alias

483

489

484renderQualifiedAlias

490renderQualifiedAlias

485 :: forall q a. (KnownSymbol q, KnownSymbol a)

491 :: forall q a. (KnownSymbol q, KnownSymbol a)

squeal-postgresql/test/Specs/ExceptionHandling.hs+8−6

@@ -45,6 +45,8 @@ type Schema =

45 ])

46 ]

48+type DB = '["public" ::: Schema]

49+

48data User =

50data User =

49 User { userName :: Text

51 User { userName :: Text

50 , userEmail :: Maybe Text

52 , userEmail :: Maybe Text

@@ -53,13 +55,13 @@ data User =

53instance SOP.Generic User

55instance SOP.Generic User

54instance SOP.HasDatatypeInfo User

56instance SOP.HasDatatypeInfo User

56−insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

58+insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

57 '[ "fromOnly" ::: 'NotNull 'PGint4 ]

59 '[ "fromOnly" ::: 'NotNull 'PGint4 ]

58insertUser = insertRows #users

60insertUser = insertRows #users

59 (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []

61 (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) []

60 OnConflictDoRaise (Returning (#id `as` #fromOnly))

62 OnConflictDoRaise (Returning (#id `as` #fromOnly))

62−setup :: Definition '[] Schema

64+setup :: Definition '["public" ::: '[]] DB

63setup =

65setup =

64 createTable #users

66 createTable #users

65 ( serial `as` #id :*

67 ( serial `as` #id :*

@@ -76,10 +78,10 @@ setup =

76 foreignKey #user_id #users #id

78 foreignKey #user_id #users #id

77 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

79 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

79−teardown :: Definition Schema '[]

81+teardown :: Definition DB '["public" ::: '[]]

80teardown = dropTable #emails >>> dropTable #users

82teardown = dropTable #emails >>> dropTable #users

82−migration :: Migration IO '[] Schema

84+migration :: Migration IO '["public" ::: '[]] DB

83migration = Migration { name = "test"

85migration = Migration { name = "test"

84 , up = void $ define setup

86 , up = void $ define setup

85 , down = void $ define teardown }

87 , down = void $ define teardown }

@@ -98,10 +100,10 @@ connectionString = "host=localhost port=5432 dbname=exampledb"

98testUser :: User

100testUser :: User

99testUser = User "TestUser" Nothing []

101testUser = User "TestUser" Nothing []

100

102

101−newUser :: (MonadBase IO m, MonadPQ Schema m) => User -> m ()

103+newUser :: (MonadBase IO m, MonadPQ DB m) => User -> m ()

102newUser u = void $ manipulateParams insertUser (userName u, userVec u)

104newUser u = void $ manipulateParams insertUser (userName u, userVec u)

103

105

104−insertUserTwice :: (MonadBase IO m, MonadPQ Schema m) => m ()

106+insertUserTwice :: (MonadBase IO m, MonadPQ DB m) => m ()

105insertUserTwice = newUser testUser >> newUser testUser

107insertUserTwice = newUser testUser >> newUser testUser

106

108

107specs :: SpecWith ()

109specs :: SpecWith ()