18f4762 · squeal · git.iko.soy

git.iko.soy/squeal

fixes

commit18f476229f7f4b4ec5f9e34787c71118c3755638 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 18 Aug 2017, 17:06 (9 years ago) parent92094a8

4 files changed+53−39

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+21−7 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+22−22 squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+8−8

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

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

11{-|

2−Module: Squeel.PostgreSQL.Binary

2+Module: Squeal.PostgreSQL.Binary

33Description: Binary encoding and decoding

44Copyright: (c) Eitan Chatav, 2017

55Maintainer: eitan@morphism.tech

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

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

222222-- the same field names.

223223class SListI results => FromRow (results :: ColumnsType) y where

224− -- | :set -XOverloadedStrings

224+ -- | >>> :set -XOverloadedStrings

225225 -- >>> import Data.Text

226226 -- >>> newtype Id = Id { getId :: Int16 } deriving Show

227227 -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue

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

@@ -14,6 +14,7 @@

1414 , ScopedTypeVariables

1515 , TypeApplications

1616 , TypeFamilies

17+ , TypeInType

1718 , TypeOperators

1819 , UndecidableInstances

1920#-}

@@ -27,6 +28,7 @@ import Control.Monad.Trans.Control

2728import Data.ByteString (ByteString)

2829import Data.Foldable

2930import Data.Function ((&))

31+import Data.Kind

3032import Data.Monoid

3133import Data.Traversable

3234import Generics.SOP

@@ -39,14 +41,18 @@ import Squeal.PostgreSQL.Binary

3941import Squeal.PostgreSQL.Statement

4042import Squeal.PostgreSQL.Schema

4143

42−newtype Connection (schema :: [(Symbol,[(Symbol,ColumnType)])]) =

44+-- | A `Connection` consists of a `Database.PastgreSQL.LibPQ.Connection`

45+-- and a phantom `Squeal.PostgreSQL.TablesType`

46+newtype Connection (schema :: TablesType) =

4347 Connection { unConnection :: LibPQ.Connection }

4448

49+-- | We keep track of the schema via an Atkey indexed state monad transformer,

50+-- `PQ`.

4551newtype PQ

46− (schema0 :: [(Symbol,[(Symbol,ColumnType)])])

47− (schema1 :: [(Symbol,[(Symbol,ColumnType)])])

48− (m :: * -> *)

49− (x :: *) =

52+ (schema0 :: TablesType)

53+ (schema1 :: TablesType)

54+ (m :: Type -> Type)

55+ (x :: Type) =

5056 PQ { runPQ :: Connection schema0 -> m (x, Connection schema1) }

5157 deriving Functor

5258

@@ -60,6 +66,7 @@ execPQ

6066 -> m (Connection schema1)

6167execPQ (PQ pq) = fmap snd . pq

6268

69+-- | indexed analog of `<*>`

6370pqAp

6471 :: Monad m

6572 => PQ schema0 schema1 m (x -> y)

@@ -70,6 +77,7 @@ pqAp (PQ f) (PQ x) = PQ $ \ conn -> do

7077 (x', conn'') <- x conn'

7178 return (f' x', conn'')

7279

80+-- | indexed analog of `=<<`

7381pqBind

7482 :: Monad m

7583 => (x -> PQ schema1 schema2 m y)

@@ -79,6 +87,7 @@ pqBind f (PQ x) = PQ $ \ conn -> do

7987 (x', conn') <- x conn

8088 runPQ (f x') conn'

8189

90+-- | indexed analog of `>>`

8291pqThen

8392 :: Monad m

8493 => PQ schema1 schema2 m y

@@ -86,6 +95,9 @@ pqThen

8695 -> PQ schema0 schema2 m y

8796pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)

8897

98+-- | Run a `Definition` with `LibPQ.exec`, we expect that libpq obeys the law

99+--

100+-- prop> then (define statement2) statement1 = define (statement2 . statement1)

89101define

90102 :: MonadBase IO io

91103 => Definition schema0 schema1

@@ -104,8 +116,10 @@ pqThenDefine

104116 -> PQ schema0 schema2 io (Result '[])

105117pqThenDefine = pqThen . define

106118

119+-- | `MonadPQ` is an `mtl` style constraint, similar to `MonadState`.

107120class Monad pq => MonadPQ schema pq | pq -> schema where

108−

121+ -- | `manipulateParams` runs a `Manipulation` with params from a type

122+ -- with a `ToParams` constraint

109123 manipulateParams

110124 :: ToParams x params

111125 => Manipulation schema params ys -> x -> pq (Result ys)

@@ -280,7 +294,7 @@ withConnection

280294 -> io x

281295withConnection connString = bracket (connectdb connString) finish

282296

283−newtype Result (xs :: [(Symbol,ColumnType)])

297+newtype Result (xs :: ColumnsType)

284298 = Result { unResult :: LibPQ.Result }

285299

286300newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }

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

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

11{-|

2−Module: Squeel.PostgreSQL.Schema

2+Module: Squeal.PostgreSQL.Schema

33Description: Embedding of PostgreSQL type and alias system

44Copyright: (c) Eitan Chatav, 2017

55Maintainer: eitan@morphism.tech

@@ -114,12 +114,12 @@ data NullityType

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

115115

116116-- | `ColumnType` encodes the allowance of @DEFAULT@ and the only way

117−-- to generate an `Optional` `Squeel.PostgreSQL.Statement.Expression`

118−-- is to use `Squeel.PostgreSQL.Statement.def`,

119−-- `Squeel.PostgreSQL.Statement.unDef` or `Squeel.PostgreSQL.Statement.param`.

117+-- to generate an `Optional` `Squeal.PostgreSQL.Statement.Expression`

118+-- is to use `Squeal.PostgreSQL.Statement.def`,

119+-- `Squeal.PostgreSQL.Statement.unDef` or `Squeal.PostgreSQL.Statement.param`.

120120data ColumnType

121121 = Optional NullityType

122− -- ^ @DEFAULT@ is an allowed `Squeel.PostgreSQL.Statement.Expression`

122+ -- ^ @DEFAULT@ is an allowed `Squeal.PostgreSQL.Statement.Expression`

123123 | Required NullityType

124124 -- ^ @DEFAULT@ is not allowed

125125

@@ -132,26 +132,26 @@ type ColumnsType = [(Symbol,ColumnType)]

132132type TablesType = [(Symbol,ColumnsType)]

133133

134134-- | `Grouping` is an auxiliary namespace, created by

135−-- @GROUP BY@ clauses (`Squeel.PostgreSQL.Statement.group`), and used by

135+-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Statement.group`), and used

136136-- for typesafe aggregation

137137data Grouping

138138 = Ungrouped

139139 | Grouped [(Symbol,Symbol)]

140140

141141-- | `PGNum` is a constraint on `PGType` whose

142−-- `Squeel.PostgreSQL.Statement.Expression`s have a `Num` constraint.

142+-- `Squeal.PostgreSQL.Statement.Expression`s have a `Num` constraint.

143143type PGNum ty =

144144 In ty '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]

145145

146146-- | `PGFloating` is a constraint on `PGType` whose

147−-- `Squeel.PostgreSQL.Statement.Expression`s

147+-- `Squeal.PostgreSQL.Statement.Expression`s

148148-- have `Fractional` and `Floating` constraints.

149149type PGFloating ty = In ty '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]

150150

151151-- | `PGIntegral` is a constraint on `PGType` whose

152−-- `Squeel.PostgreSQL.Statement.Expression`s

153−-- have `Squeel.PostgreSQL.Statement.div_` and

154−-- `Squeel.PostgreSQL.Statement.mod_` functions.

152+-- `Squeal.PostgreSQL.Statement.Expression`s

153+-- have `Squeal.PostgreSQL.Statement.div_` and

154+-- `Squeal.PostgreSQL.Statement.mod_` functions.

155155type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8]

156156

157157-- | `:::` is the promoted version of `As`, a type level pair between

@@ -259,43 +259,43 @@ type family NullifyColumns (columns :: ColumnsType) :: ColumnsType where

259259

260260-- | `NullifyTables` is an idempotent that nullifies a `TablesType`

261261-- used to nullify the left or right hand side of an outer join

262−-- in a `Squeel.PostgreSQL.Statement.FromClause`

262+-- in a `Squeal.PostgreSQL.Statement.FromClause`

263263type family NullifyTables (tables :: TablesType) :: TablesType where

264264 NullifyTables '[] = '[]

265265 NullifyTables ((table ::: columns) ': tables) =

266266 (table ::: NullifyColumns columns) ': NullifyTables tables

267267

268268-- | `Join` is simply promoted `++` and is used in @JOIN@s in

269−-- `Squeel.PostgreSQL.Statement.FromClause`s.

269+-- `Squeal.PostgreSQL.Statement.FromClause`s.

270270type family Join xs ys where

271271 Join '[] ys = ys

272272 Join (x ': xs) ys = x ': Join xs ys

273273

274274-- | `Create alias x xs` adds `alias ::: x` to the end of `xs` and is used in

275−-- `Squeel.PostgreSQL.Statement.createTable` statements and in @ALTER TABLE@

276−-- `Squeel.PostgreSQL.Statement.addColumnDefault` and

277−-- `Squeel.PostgreSQL.Statement.addColumnNull` statements

275+-- `Squeal.PostgreSQL.Statement.createTable` statements and in @ALTER TABLE@

276+-- `Squeal.PostgreSQL.Statement.addColumnDefault` and

277+-- `Squeal.PostgreSQL.Statement.addColumnNull` statements

278278type family Create alias x xs where

279279 Create alias x '[] = '[alias ::: x]

280280 Create alias y (x ': xs) = x ': Create alias y xs

281281

282282-- | `Drop alias xs` removes the type associated with `alias` in `xs`

283−-- and is used in `Squeel.PostgreSQL.Statement.dropTable` statements

284−-- and in @ALTER TABLE@ `Squeel.PostgreSQL.Statement.dropColumn` statements

283+-- and is used in `Squeal.PostgreSQL.Statement.dropTable` statements

284+-- and in @ALTER TABLE@ `Squeal.PostgreSQL.Statement.dropColumn` statements

285285type family Drop alias xs where

286286 Drop alias ((alias ::: x) ': xs) = xs

287287 Drop alias (x ': xs) = x ': Drop alias xs

288288

289289-- | `Alter alias xs x` replaces the type associated with an `alias` in `xs`

290−-- with the type `x` and is used in `Squeel.PostgreSQL.Statement.alterTable`

291−-- and `Squeel.PostgreSQL.Statement.alterColumn`.

290+-- with the type `x` and is used in `Squeal.PostgreSQL.Statement.alterTable`

291+-- and `Squeal.PostgreSQL.Statement.alterColumn`.

292292type family Alter alias xs x where

293293 Alter alias ((alias ::: x0) ': xs) x1 = (alias ::: x1) ': xs

294294 Alter alias (x0 ': xs) x1 = x0 ': Alter alias xs x1

295295

296296-- | `Rename alias0 alias1 xs` replaces the alias `alias0` by `alias1` in `xs`

297−-- and is used in `Squeel.PostgreSQL.Statement.alterTableRename` and

298−-- `Squeel.PostgreSQL.Statement.renameColumn`

297+-- and is used in `Squeal.PostgreSQL.Statement.alterTableRename` and

298+-- `Squeal.PostgreSQL.Statement.renameColumn`

299299type family Rename alias0 alias1 xs where

300300 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs

301301 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs

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

@@ -389,7 +389,7 @@ isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"

389389-- | analagous to `maybe` using @IS NULL@

390390--

391391-- >>> renderExpression $ matchNull true not_ null_

392−-- "CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT TRUE) END"

392+-- "CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END"

393393matchNull

394394 :: Expression params tables grouping ('Required nullty)

395395 -> ( Expression params tables grouping ('Required ('NotNull ty))

@@ -397,7 +397,7 @@ matchNull

397397 -> Expression params tables grouping ('Required ('Null ty))

398398 -> Expression params tables grouping ('Required nullty)

399399matchNull y f x = ifThenElse (isNull x) y

400− (f (UnsafeExpression (renderExpression y)))

400+ (f (UnsafeExpression (renderExpression x)))

401401

402402-- | right inverse to `fromNull`

403403--

@@ -708,7 +708,7 @@ data By

708708 (tables :: TablesType)

709709 (by :: (Symbol,Symbol)) where

710710 By

711− :: (tables ~ '[table ::: columns], HasColumn column columns ty)

711+ :: (HasUnique table tables columns, HasColumn column columns ty)

712712 => Alias column

713713 -> By tables '(table, column)

714714 By2

@@ -756,7 +756,7 @@ renderHavingClause = \case

756756class (KnownSymbol table, KnownSymbol column)

757757 => GroupedBy table column bys where

758758 getGroup1

759− :: (tables ~ '[table ::: columns], HasColumn column columns ty)

759+ :: (HasUnique table tables columns, HasColumn column columns ty)

760760 => Alias column

761761 -> Expression params tables ('Grouped bys) ty

762762 getGroup1 column = UnsafeExpression $ renderAlias column

@@ -1270,13 +1270,13 @@ selectDistinct list tabs = UnsafeQuery $

12701270 <+> renderTableExpression tabs

12711271

12721272selectStar

1273− :: tables ~ '[table ::: columns]

1273+ :: HasUnique table tables columns

12741274 => TableExpression params schema tables 'Ungrouped

12751275 -> Query schema params columns

12761276selectStar tabs = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression tabs

12771277

12781278selectDistinctStar

1279− :: tables ~ '[table ::: columns]

1279+ :: HasUnique table tables columns

12801280 => TableExpression params schema tables 'Ungrouped

12811281 -> Query schema params columns

12821282selectDistinctStar tabs = UnsafeQuery $

@@ -1434,8 +1434,8 @@ alterTableRename table0 table1 = UnsafeDefinition $

14341434 <+> "RENAME TO" <+> renderAlias table1 <> ";"

14351435

14361436newtype AlterTable

1437− (columns0 :: [(Symbol, ColumnType)])

1438− (columns1 :: [(Symbol, ColumnType)]) =

1437+ (columns0 :: ColumnsType)

1438+ (columns1 :: ColumnsType) =

14391439 UnsafeAlterTable {renderAlterTable :: ByteString}

14401440 deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

14411441