9b15cc6 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

with stuff

9b15cc6Eitan Chatav8 years ago

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+5−1

compare with dev

unifiedsplit

@@ -187,9 +187,13 @@ newtype Manipulation

187 (columns :: RowType)

188 = UnsafeManipulation { renderManipulation :: ByteString }

189 deriving (GHC.Generic,Show,Eq,Ord,NFData)

190−

191instance RenderSQL (Manipulation schema params columns) where

190instance RenderSQL (Manipulation schema params columns) where

192 renderSQL = renderManipulation

191 renderSQL = renderManipulation

192+instance With' Manipulation where

193+ with' Done manip = manip

194+ with' (cte :>> ctes) manip = UnsafeManipulation $

195+ "WITH" <+> renderCtes renderManipulation cte ctes

196+ <+> renderManipulation manip

193

197

194-- | Convert a `Query` into a `Manipulation`.

198-- | Convert a `Query` into a `Manipulation`.

195queryStatement

199queryStatement

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−20

@@ -105,9 +105,6 @@ module Squeal.PostgreSQL.Migration

105 Migration (..)

106 , migrateUp

107 , migrateDown

108− -- * Aligned lists

109− , AlignedList (..)

110− , single

111 -- * Migration table

108 -- * Migration table

112 , MigrationsTable

109 , MigrationsTable

113 , createMigrations

110 , createMigrations

@@ -116,7 +113,6 @@ module Squeal.PostgreSQL.Migration

116 , selectMigration

113 , selectMigration

117 ) where

114 ) where

118

115

119−import Control.Category

120import Control.Monad

116import Control.Monad

121import Control.Monad.Base

117import Control.Monad.Base

122import Control.Monad.Trans.Control

118import Control.Monad.Trans.Control

@@ -124,7 +120,6 @@ import Data.Monoid

124import Generics.SOP (K(..))

120import Generics.SOP (K(..))

125import Data.Function ((&))

121import Data.Function ((&))

126import Data.Text (Text)

122import Data.Text (Text)

127−import Prelude hiding (id, (.))

128

123

129import Squeal.PostgreSQL

124import Squeal.PostgreSQL

130

125

@@ -137,21 +132,6 @@ data Migration io schema0 schema1 = Migration

137 , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.

132 , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.

138 }

133 }

139

134

140−-- | An `AlignedList` is a type-aligned list or free category.

141−data AlignedList p x0 x1 where

142− Done :: AlignedList p x x

143− (:>>) :: p x0 x1 -> AlignedList p x1 x2 -> AlignedList p x0 x2

144−infixr 7 :>>

145−instance Category (AlignedList p) where

146− id = Done

147− (.) list = \case

148− Done -> list

149− step :>> steps -> step :>> (steps >>> list)

150−

151−-- | A `single` step.

152−single :: p x0 x1 -> AlignedList p x0 x1

153−single step = step :>> Done

154−

155-- | Run `Migration`s by creating the `MigrationsTable`

135-- | Run `Migration`s by creating the `MigrationsTable`

156-- if it does not exist and then in a transaction, for each each `Migration`

136-- if it does not exist and then in a transaction, for each each `Migration`

157-- query to see if the `Migration` is executed. If not, then

137-- query to see if the `Migration` is executed. If not, then

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+85

@@ -118,6 +118,10 @@ module Squeal.PostgreSQL.Query

118 , rowAllGte

119 , anyGte

120 , rowAnyGte

121+ , With' (with')

122+ , CommonTableExpression (..)

123+ , renderCte

124+ , renderCtes

121 ) where

125 ) where

122

126

123import Control.DeepSeq

127import Control.DeepSeq

@@ -324,6 +328,43 @@ let

324in printSQL query

328in printSQL query

325:}

329:}

326(SELECT * FROM "tab" AS "tab") UNION ALL (SELECT * FROM "tab" AS "tab")

330(SELECT * FROM "tab" AS "tab") UNION ALL (SELECT * FROM "tab" AS "tab")

331+

332+with queries:

333+

334+>>> :{

335+let

336+ query :: Query

337+ '[ "orders" ::: 'View

338+ '[ "region" ::: 'NotNull 'PGtext

339+ , "product" ::: 'NotNull 'PGtext

340+ , "quantity" ::: 'NotNull 'PGint8

341+ , "amount" ::: 'NotNull 'PGnumeric ] ]

342+ '[ 'NotNull 'PGint8 ]

343+ '[ "region" ::: 'NotNull 'PGtext

344+ , "product" ::: 'NotNull 'PGtext

345+ , "product_units" ::: 'NotNull 'PGint8

346+ , "product_sales" ::: 'NotNull 'PGnumeric ]

347+ query = with' (

348+ CommonTableExpression

349+ (((select (#region :* sum_ @'PGnumeric #amount `as` #total_sales)

350+ (from (view #orders) & groupBy #region))

351+ `as` #regional_sales)) :>>

352+ CommonTableExpression

353+ (((select (#region `as` #region)

354+ (from (view #regional_sales) & where_ (#total_sales .> param @1)))

355+ `as` #top_regions)) :>> Done

356+ ) (select (

357+ #region :*

358+ #product :*

359+ sum_ #quantity `as` #product_units :*

360+ sum_ #amount `as` #product_sales

361+ ) (from (view #orders)

362+ & where_ (#region `in_` select #region (from (view #top_regions)))

363+ & groupBy (#region :* #product))

364+ )

365+in printSQL query

366+:}

367+

327-}

368-}

328newtype Query

369newtype Query

329 (schema :: SchemaType)

370 (schema :: SchemaType)

@@ -1287,3 +1328,47 @@ rowAnyGte

1287 -> Query schema params row

1328 -> Query schema params row

1288 -> Condition schema from grp params

1329 -> Condition schema from grp params

1289rowAnyGte = unsafeRowSubqueryExpression "ANY >="

1330rowAnyGte = unsafeRowSubqueryExpression "ANY >="

1331+

1332+data CommonTableExpression statement

1333+ (params :: [NullityType])

1334+ (schema0 :: SchemaType)

1335+ (schema1 :: SchemaType) where

1336+ CommonTableExpression

1337+ :: Aliased (statement schema params) (alias ::: cte)

1338+ -> CommonTableExpression

1339+ statement params schema (alias ::: 'View cte ': schema)

1340+instance KnownSymbol alias => Aliasable alias (statement schema params cte)

1341+ (CommonTableExpression statement params schema

1342+ (alias ::: 'View cte ': schema)) where

1343+ statement `as` alias = CommonTableExpression (statement `As` alias)

1344+instance KnownSymbol alias => Aliasable alias (statement schema params cte)

1345+ (AlignedList (CommonTableExpression statement params) schema

1346+ (alias ::: 'View cte ': schema)) where

1347+ statement `as` alias = statement `as` alias :>> Done

1348+

1349+renderCte

1350+ :: (forall sch ps row. statement ps sch row -> ByteString)

1351+ -> CommonTableExpression statement params schema0 schema1 -> ByteString

1352+renderCte renderStatement (CommonTableExpression (statement `As` alias)) =

1353+ renderAlias alias <+> "AS" <+> parenthesized (renderStatement statement)

1354+

1355+renderCtes

1356+ :: (forall sch ps row. statement ps sch row -> ByteString)

1357+ -> CommonTableExpression statement params schema0 schema1

1358+ -> AlignedList (CommonTableExpression statement params) schema1 schema2

1359+ -> ByteString

1360+renderCtes renderStatement cte ctes =

1361+ renderCte renderStatement cte <+> case ctes of

1362+ Done -> ""

1363+ cte' :>> ctes' -> "," <+>

1364+ renderCtes renderStatement cte' ctes'

1365+

1366+class With' statement where

1367+ with'

1368+ :: AlignedList (CommonTableExpression statement params) schema0 schema1

1369+ -> statement schema1 params row

1370+ -> statement schema0 params row

1371+instance With' Query where

1372+ with' Done query = query

1373+ with' (cte :>> ctes) query = UnsafeQuery $

1374+ "WITH" <+> renderCtes renderQuery cte ctes <+> renderQuery query

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

@@ -20,6 +20,7 @@ it defines an embedding of Haskell types into Postgres types.

20 , FlexibleInstances

21 , FunctionalDependencies

22 , GADTs

23+ , LambdaCase

23 , OverloadedStrings

24 , OverloadedStrings

24 , RankNTypes

25 , RankNTypes

25 , ScopedTypeVariables

26 , ScopedTypeVariables

@@ -122,8 +123,12 @@ module Squeal.PostgreSQL.Schema

122 , ConstructorsOf

123 , ConstructorsOf

123 , ConstructorNameOf

124 , ConstructorNameOf

124 , ConstructorNamesOf

125 , ConstructorNamesOf

126+ -- * Aligned lists

127+ , AlignedList (..)

128+ , single

125 ) where

129 ) where

126

130

131+import Control.Category

127import Control.DeepSeq

132import Control.DeepSeq

128import Data.Aeson (Value)

133import Data.Aeson (Value)

129import Data.ByteString (ByteString)

134import Data.ByteString (ByteString)

@@ -142,6 +147,7 @@ import Generics.SOP.Record

142import GHC.OverloadedLabels

147import GHC.OverloadedLabels

143import GHC.TypeLits

148import GHC.TypeLits

144import Network.IP.Addr

149import Network.IP.Addr

150+import Prelude hiding (id, (.))

145

151

146import qualified Data.ByteString.Lazy as Lazy

152import qualified Data.ByteString.Lazy as Lazy

147import qualified Data.Text.Lazy as Lazy

153import qualified Data.Text.Lazy as Lazy

@@ -810,3 +816,18 @@ type PGjsonKey key = key `In` '[ 'PGint2, 'PGint4, 'PGtext ]

810

816

811-- | Is a type a valid JSON type?

817-- | Is a type a valid JSON type?

812type PGjson_ json = json `In` '[ 'PGjson, 'PGjsonb ]

818type PGjson_ json = json `In` '[ 'PGjson, 'PGjsonb ]

819+

820+-- | An `AlignedList` is a type-aligned list or free category.

821+data AlignedList p x0 x1 where

822+ Done :: AlignedList p x x

823+ (:>>) :: p x0 x1 -> AlignedList p x1 x2 -> AlignedList p x0 x2

824+infixr 7 :>>

825+instance Category (AlignedList p) where

826+ id = Done

827+ (.) list = \case

828+ Done -> list

829+ step :>> steps -> step :>> (steps >>> list)

830+

831+-- | A `single` step.

832+single :: p x0 x1 -> AlignedList p x0 x1

833+single step = step :>> Done