27aec99 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

docs & tests

27aec99Eitan Chatav9 years ago

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

compare with dev

unifiedsplit

@@ -5,6 +5,7 @@

5-- Stability: experimental

6--

7-- Squeal is a deep embedding of PostgreSQL in Haskell. Let's see an example!

8+-- FIX DOCS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

8--

9--

9-- First, we need some language extensions because Squeal uses modern GHC

10-- First, we need some language extensions because Squeal uses modern GHC

10-- features.

11-- features.

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+2−2

@@ -115,7 +115,7 @@ instance ToParam UTCTime 'PGtimestamptz where

115instance ToParam DiffTime 'PGinterval where toParam = K . Encoding.interval_int

116instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast

117instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast

118−instance (Oid pg, ToParam x pg)

118+instance (HasOid pg, ToParam x pg)

119 => ToParam (Vector (Maybe x)) ('PGarray pg) where

120 toParam = K . Encoding.nullableArray_vector

121 (oid (Proxy @pg)) (unK . toParam @x @pg)

@@ -237,7 +237,7 @@ instance FromValue pg y

237 err str = error $ "fromColumnValue: " ++ Strict.unpack str

238

239-- | A `FromRow` constraint generically sequences the parsings of the columns

240−-- of a `ColumnsType` into the fields of a record `Type` provided they have

240+-- of a `RelationType` into the fields of a record `Type` provided they have

241-- the same field names. You should not define instances of `FromRow`.

242-- Instead define `Generic` and `HasDatatypeInfo` instances which in turn

243-- provide `FromRow` instances.

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+113−29

@@ -5,7 +5,7 @@ Copyright: (c) Eitan Chatav, 2017

5Maintainer: eitan@morphism.tech

6Stability: experimental

8−Embedding of PostgreSQL type and alias system

8+A type-level DSL for kinds of PostgreSQL types, constraints, and aliases.

9-}

11{-# LANGUAGE

@@ -33,9 +33,9 @@ Embedding of PostgreSQL type and alias system

33#-}

35module Squeal.PostgreSQL.Schema

36− ( -- * Kinds

36+ ( -- * Types

37 PGType (..)

38− , Oid (..)

38+ , HasOid (..)

39 , NullityType (..)

40 , ColumnType

41 , ColumnsType

@@ -44,14 +44,14 @@ module Squeal.PostgreSQL.Schema

44 , TableType

45 , TablesType

46 , Grouping (..)

47− -- * PostgreSQL Constraints

47+ -- * Constraints

48 , (:=>)

49 , ColumnsToRelation

50 , TableToColumns

51 , TablesToRelations

52 , ColumnConstraint (..)

53 , TableConstraint (..)

54− -- * AliasesOf

54+ -- * Aliases

55 , (:::)

56 , Alias (Alias)

57 , renderAlias

@@ -100,6 +100,10 @@ import GHC.TypeLits

100import qualified Generics.SOP.Type.Metadata as Type

101

102-- | `PGType` is the promoted datakind of PostgreSQL types.

103+--

104+-- >>> import Squeal.PostgreSQL.Schema

105+-- >>> :kind 'PGbool

106+-- 'PGbool :: PGType

103data PGType

107data PGType

104 = PGbool -- ^ logical Boolean (true/false)

108 = PGbool -- ^ logical Boolean (true/false)

105 | PGint2 -- ^ signed two-byte integer

109 | PGint2 -- ^ signed two-byte integer

@@ -127,42 +131,54 @@ data PGType

127 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

131 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

128

132

129-- | The object identifier of a `PGType`.

133-- | The object identifier of a `PGType`.

134+--

135+-- >>> :set -XTypeApplications

136+-- >>> import Data.Proxy

137+-- >>> oid (Proxy @'PGbool)

138+-- 16

130−class Oid (ty :: PGType) where oid :: proxy ty -> Word32

139+class HasOid (ty :: PGType) where oid :: proxy ty -> Word32

131−instance Oid 'PGbool where oid _ = 16

140+instance HasOid 'PGbool where oid _ = 16

132−instance Oid 'PGint2 where oid _ = 21

141+instance HasOid 'PGint2 where oid _ = 21

133−instance Oid 'PGint4 where oid _ = 23

142+instance HasOid 'PGint4 where oid _ = 23

134−instance Oid 'PGint8 where oid _ = 20

143+instance HasOid 'PGint8 where oid _ = 20

135−instance Oid 'PGnumeric where oid _ = 1700

144+instance HasOid 'PGnumeric where oid _ = 1700

136−instance Oid 'PGfloat4 where oid _ = 700

145+instance HasOid 'PGfloat4 where oid _ = 700

137−instance Oid 'PGfloat8 where oid _ = 701

146+instance HasOid 'PGfloat8 where oid _ = 701

138−instance Oid ('PGchar n) where oid _ = 18

147+instance HasOid ('PGchar n) where oid _ = 18

139−instance Oid ('PGvarchar n) where oid _ = 1043

148+instance HasOid ('PGvarchar n) where oid _ = 1043

140−instance Oid 'PGtext where oid _ = 25

149+instance HasOid 'PGtext where oid _ = 25

141−instance Oid 'PGbytea where oid _ = 17

150+instance HasOid 'PGbytea where oid _ = 17

142−instance Oid 'PGtimestamp where oid _ = 1114

151+instance HasOid 'PGtimestamp where oid _ = 1114

143−instance Oid 'PGtimestamptz where oid _ = 1184

152+instance HasOid 'PGtimestamptz where oid _ = 1184

144−instance Oid 'PGdate where oid _ = 1082

153+instance HasOid 'PGdate where oid _ = 1082

145−instance Oid 'PGtime where oid _ = 1083

154+instance HasOid 'PGtime where oid _ = 1083

146−instance Oid 'PGtimetz where oid _ = 1266

155+instance HasOid 'PGtimetz where oid _ = 1266

147−instance Oid 'PGinterval where oid _ = 1186

156+instance HasOid 'PGinterval where oid _ = 1186

148−instance Oid 'PGuuid where oid _ = 2950

157+instance HasOid 'PGuuid where oid _ = 2950

149−instance Oid 'PGinet where oid _ = 869

158+instance HasOid 'PGinet where oid _ = 869

150−instance Oid 'PGjson where oid _ = 114

159+instance HasOid 'PGjson where oid _ = 114

151−instance Oid 'PGjsonb where oid _ = 3802

160+instance HasOid 'PGjsonb where oid _ = 3802

152

161

153-- | `NullityType` encodes the potential presence or definite absence of a

162-- | `NullityType` encodes the potential presence or definite absence of a

154-- @NULL@ allowing operations which are sensitive to such to be well typed.

163-- @NULL@ allowing operations which are sensitive to such to be well typed.

164+--

165+-- >>> :kind 'Null 'PGint4

166+-- 'Null 'PGint4 :: NullityType

167+-- >>> :kind 'NotNull ('PGvarchar 50)

168+-- 'NotNull ('PGvarchar 50) :: NullityType

155data NullityType

169data NullityType

156 = Null PGType -- ^ @NULL@ may be present

170 = Null PGType -- ^ @NULL@ may be present

157 | NotNull PGType -- ^ @NULL@ is absent

171 | NotNull PGType -- ^ @NULL@ is absent

158

172

173+-- | The constraint operator, `:=>` is a type level pair

159−-- | `:=>` is a type level pair between an "constraint" and some type,

174+-- between an "constraint" and some type,

160-- either a `ColumnConstraint` and a `NullityType` or a row of

175-- either a `ColumnConstraint` and a `NullityType` or a row of

161-- `TableConstraint`s and a `TableType`.

176-- `TableConstraint`s and a `TableType`.

162type (:=>) constraint ty = '(constraint,ty)

177type (:=>) constraint ty = '(constraint,ty)

163infixr 7 :=>

178infixr 7 :=>

164

179

180+-- | The alias operator `:::` is like a promoted version of `As`,

165−-- | `:::` is like a promoted version of `As`, a type level pair between

181+-- a type level pair between

166-- an alias and some type, like a column alias and either a `ColumnType` or

182-- an alias and some type, like a column alias and either a `ColumnType` or

167-- `NullityType` or a table alias and either a `TableType` or a `RelationType`

183-- `NullityType` or a table alias and either a `TableType` or a `RelationType`

168-- or a constraint alias and a `TableConstraint`.

184-- or a constraint alias and a `TableConstraint`.

@@ -176,9 +192,31 @@ data ColumnConstraint

176

192

177-- | `ColumnType` encodes the allowance of @DEFAULT@ and @NULL@ and the

193-- | `ColumnType` encodes the allowance of @DEFAULT@ and @NULL@ and the

178-- base `PGType` for a column.

194-- base `PGType` for a column.

195+--

196+-- >>> :kind 'NoDef :=> 'NotNull 'PGint4

197+-- 'NoDef :=> 'NotNull 'PGint4 :: (ColumnConstraint, NullityType)

198+-- >>> :kind 'NoDef :=> 'NotNull 'PGtext

199+-- 'NoDef :=> 'NotNull 'PGtext :: (ColumnConstraint, NullityType)

200+-- >>> import Data.Type.Equality

201+-- >>> Refl :: ColumnType :~: (ColumnConstraint, NullityType)

202+-- Refl

179type ColumnType = (ColumnConstraint,NullityType)

203type ColumnType = (ColumnConstraint,NullityType)

180

204

181-- | `ColumnsType` is a row of `ColumnType`s.

205-- | `ColumnsType` is a row of `ColumnType`s.

206+--

207+-- >>> import GHC.TypeLits

208+-- >>> :{

209+-- type Columns =

210+-- '[ "name" ::: 'NoDef :=> 'NotNull 'PGtext

211+-- , "id" ::: 'Def :=> 'NotNull 'PGint4

212+-- ]

213+-- :}

214+--

215+-- >>> :kind Columns

216+-- Columns :: [(Symbol, (ColumnConstraint, NullityType))]

217+-- >>> import Data.Type.Equality

218+-- >>> Refl :: ColumnsType :~: [(Symbol, (ColumnConstraint, NullityType))]

219+-- Refl

182type ColumnsType = [(Symbol,ColumnType)]

220type ColumnsType = [(Symbol,ColumnType)]

183

221

184-- | `TableConstraint` encodes various forms of data constraints

222-- | `TableConstraint` encodes various forms of data constraints

@@ -191,18 +229,64 @@ data TableConstraint

191

229

192-- | `TableType` encodes a row of constraints on a table as well as the types

230-- | `TableType` encodes a row of constraints on a table as well as the types

193-- of its columns.

231-- of its columns.

232+--

233+-- >>> :{

234+-- type UsersTable =

235+-- '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>

236+-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4

237+-- , "name" ::: 'NoDef :=> 'NotNull 'PGtext

238+-- ]

239+-- :}

240+--

241+-- >>> :kind UsersTable

242+-- UsersTable :: ([(Symbol, TableConstraint)],

243+-- [(Symbol, (ColumnConstraint, NullityType))])

194type TableType = ([(Symbol,TableConstraint)],ColumnsType)

244type TableType = ([(Symbol,TableConstraint)],ColumnsType)

195

245

196-- | `TablesType` is a row of `TableType`s, thought of as a union.

246-- | `TablesType` is a row of `TableType`s, thought of as a union.

247+--

248+-- >>> :set -XTypeFamilies -XTypeInType

249+-- >>> :{

250+-- type family Schema :: TablesType where

251+-- Schema =

252+-- '[ "users" :::

253+-- '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>

254+-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4

255+-- , "name" ::: 'NoDef :=> 'NotNull 'PGtext

256+-- , "vec" ::: 'NoDef :=> 'NotNull ('PGarray 'PGint2)

257+-- ]

258+-- , "emails" :::

259+-- '[ "pk_emails" ::: 'PrimaryKey '["id"]

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

261+-- ] :=>

262+-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4

263+-- , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4

264+-- , "email" ::: 'NoDef :=> 'Null 'PGtext

265+-- ]

266+-- ]

267+-- :}

268+--

197type TablesType = [(Symbol,TableType)]

269type TablesType = [(Symbol,TableType)]

198

270

199-- | `RelationType` is a row of `NullityType`

271-- | `RelationType` is a row of `NullityType`

272+--

273+-- >>> :{

274+-- type Relation =

275+-- '[ "name" ::: 'NotNull 'PGtext

276+-- , "age" ::: 'NotNull 'PGint4

277+-- , "dateOfBirth" ::: 'Null 'PGdate

278+-- ]

279+-- :}

280+--

281+-- >>> :kind Relation

282+-- Relation :: [(Symbol, NullityType)]

200type RelationType = [(Symbol,NullityType)]

283type RelationType = [(Symbol,NullityType)]

201

284

202-- | `RelationsType` is a row of `RelationType`s, thought of as a product.

285-- | `RelationsType` is a row of `RelationType`s, thought of as a product.

203type RelationsType = [(Symbol,RelationType)]

286type RelationsType = [(Symbol,RelationType)]

204

287

205-- | `ColumnsToRelation` removes column constraints.

288-- | `ColumnsToRelation` removes column constraints.

289+--

206type family ColumnsToRelation (columns :: ColumnsType) :: RelationType where

290type family ColumnsToRelation (columns :: ColumnsType) :: RelationType where

207 ColumnsToRelation '[] = '[]

291 ColumnsToRelation '[] = '[]

208 ColumnsToRelation (column ::: constraint :=> ty ': columns) =

292 ColumnsToRelation (column ::: constraint :=> ty ': columns) =