18f4762 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

fixes

18f4762Eitan Chatav9 years ago

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

compare with dev

unifiedsplit

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

1{-|

2−Module: Squeel.PostgreSQL.Binary

2+Module: Squeal.PostgreSQL.Binary

3Description: Binary encoding and decoding

4Copyright: (c) Eitan Chatav, 2017

5Maintainer: eitan@morphism.tech

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

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

222-- the same field names.

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

224− -- | :set -XOverloadedStrings

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

225 -- >>> import Data.Text

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

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

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

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

14 , ScopedTypeVariables

15 , TypeApplications

16 , TypeFamilies

17+ , TypeInType

17 , TypeOperators

18 , TypeOperators

18 , UndecidableInstances

19 , UndecidableInstances

19#-}

20#-}

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

27import Data.ByteString (ByteString)

28import Data.ByteString (ByteString)

28import Data.Foldable

29import Data.Foldable

29import Data.Function ((&))

30import Data.Function ((&))

31+import Data.Kind

30import Data.Monoid

32import Data.Monoid

31import Data.Traversable

33import Data.Traversable

32import Generics.SOP

34import Generics.SOP

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

39import Squeal.PostgreSQL.Statement

41import Squeal.PostgreSQL.Statement

40import Squeal.PostgreSQL.Schema

42import Squeal.PostgreSQL.Schema

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

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

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

46+newtype Connection (schema :: TablesType) =

43 Connection { unConnection :: LibPQ.Connection }

47 Connection { unConnection :: LibPQ.Connection }

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

50+-- `PQ`.

45newtype PQ

51newtype PQ

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

52+ (schema0 :: TablesType)

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

53+ (schema1 :: TablesType)

48− (m :: * -> *)

54+ (m :: Type -> Type)

49− (x :: *) =

55+ (x :: Type) =

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

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

51 deriving Functor

57 deriving Functor

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

60 -> m (Connection schema1)

66 -> m (Connection schema1)

61execPQ (PQ pq) = fmap snd . pq

67execPQ (PQ pq) = fmap snd . pq

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

63pqAp

70pqAp

64 :: Monad m

71 :: Monad m

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

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

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

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

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

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

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

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

73pqBind

81pqBind

74 :: Monad m

82 :: Monad m

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

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

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

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

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

80 runPQ (f x') conn'

88 runPQ (f x') conn'

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

82pqThen

91pqThen

83 :: Monad m

92 :: Monad m

84 => PQ schema1 schema2 m y

93 => PQ schema1 schema2 m y

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

86 -> PQ schema0 schema2 m y

95 -> PQ schema0 schema2 m y

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

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

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

99+--

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

89define

101define

90 :: MonadBase IO io

102 :: MonadBase IO io

91 => Definition schema0 schema1

103 => Definition schema0 schema1

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

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

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

105pqThenDefine = pqThen . define

117pqThenDefine = pqThen . define

106

118

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

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

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

108−

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

122+ -- with a `ToParams` constraint

109 manipulateParams

123 manipulateParams

110 :: ToParams x params

124 :: ToParams x params

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

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

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

280 -> io x

294 -> io x

281withConnection connString = bracket (connectdb connString) finish

295withConnection connString = bracket (connectdb connString) finish

282

296

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

297+newtype Result (xs :: ColumnsType)

284 = Result { unResult :: LibPQ.Result }

298 = Result { unResult :: LibPQ.Result }

285

299

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

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

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

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

1{-|

2−Module: Squeel.PostgreSQL.Schema

2+Module: Squeal.PostgreSQL.Schema

3Description: Embedding of PostgreSQL type and alias system

4Copyright: (c) Eitan Chatav, 2017

5Maintainer: eitan@morphism.tech

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

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

115

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

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

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

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

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

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

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

120data ColumnType

121 = Optional NullityType

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

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

123 | Required NullityType

124 -- ^ @DEFAULT@ is not allowed

125

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

132type TablesType = [(Symbol,ColumnsType)]

133

134-- | `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

136-- for typesafe aggregation

137data Grouping

138 = Ungrouped

139 | Grouped [(Symbol,Symbol)]

140

141-- | `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.

143type PGNum ty =

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

145

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

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

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

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

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

150

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

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

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

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

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

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

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

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

156

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

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

259

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

261-- 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`

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

264 NullifyTables '[] = '[]

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

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

267

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

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

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

270type family Join xs ys where

271 Join '[] ys = ys

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

273

274-- | `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@

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

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

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

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

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

278type family Create alias x xs where

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

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

281

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

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

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

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

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

285type family Drop alias xs where

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

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

288

289-- | `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`

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

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

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

292type family Alter alias xs x where

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

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

295

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

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

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

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

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

299type family Rename alias0 alias1 xs where

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

301 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"

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

390--

391-- >>> 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"

393matchNull

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

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

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

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

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

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

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

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

401

402-- | right inverse to `fromNull`

403--

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

708 (tables :: TablesType)

709 (by :: (Symbol,Symbol)) where

710 By

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

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

712 => Alias column

713 -> By tables '(table, column)

714 By2

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

756class (KnownSymbol table, KnownSymbol column)

757 => GroupedBy table column bys where

758 getGroup1

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

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

760 => Alias column

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

762 getGroup1 column = UnsafeExpression $ renderAlias column

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

1270 <+> renderTableExpression tabs

1271

1272selectStar

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

1273+ :: HasUnique table tables columns

1274 => TableExpression params schema tables 'Ungrouped

1275 -> Query schema params columns

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

1277

1278selectDistinctStar

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

1279+ :: HasUnique table tables columns

1280 => TableExpression params schema tables 'Ungrouped

1281 -> Query schema params columns

1282selectDistinctStar tabs = UnsafeQuery $

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

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

1435

1436newtype AlterTable

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

1437+ (columns0 :: ColumnsType)

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

1438+ (columns1 :: ColumnsType) =

1439 UnsafeAlterTable {renderAlterTable :: ByteString}

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

1441