9b15cc6 · squeal · git.iko.soy

git.iko.soy/squeal

with stuff

common table expressions

commit9b15cc6eb4498ff1720e8b3dd39bb65e5e73d08a authorEitan Chatav <eitan.chatav@gmail.com> dateThu 16 Aug 2018, 22:13 (8 years ago) parent7053d25

4 files changed+111−21

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+5−1 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−20 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+85 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+21

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

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

187187 (columns :: RowType)

188188 = UnsafeManipulation { renderManipulation :: ByteString }

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

190−

191190instance RenderSQL (Manipulation schema params columns) where

192191 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

193197

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

195199queryStatement

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

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

105105 Migration (..)

106106 , migrateUp

107107 , migrateDown

108− -- * Aligned lists

109− , AlignedList (..)

110− , single

111108 -- * Migration table

112109 , MigrationsTable

113110 , createMigrations

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

116113 , selectMigration

117114 ) where

118115

119−import Control.Category

120116import Control.Monad

121117import Control.Monad.Base

122118import Control.Monad.Trans.Control

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

124120import Generics.SOP (K(..))

125121import Data.Function ((&))

126122import Data.Text (Text)

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

128123

129124import Squeal.PostgreSQL

130125

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

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

138133 }

139134

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−

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

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

157137-- 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

118118 , rowAllGte

119119 , anyGte

120120 , rowAnyGte

121+ , With' (with')

122+ , CommonTableExpression (..)

123+ , renderCte

124+ , renderCtes

121125 ) where

122126

123127import Control.DeepSeq

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

324328in printSQL query

325329:}

326330(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+

327368-}

328369newtype Query

329370 (schema :: SchemaType)

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

12871328 -> Query schema params row

12881329 -> Condition schema from grp params

12891330rowAnyGte = 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.

2020 , FlexibleInstances

2121 , FunctionalDependencies

2222 , GADTs

23+ , LambdaCase

2324 , OverloadedStrings

2425 , RankNTypes

2526 , ScopedTypeVariables

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

122123 , ConstructorsOf

123124 , ConstructorNameOf

124125 , ConstructorNamesOf

126+ -- * Aligned lists

127+ , AlignedList (..)

128+ , single

125129 ) where

126130

131+import Control.Category

127132import Control.DeepSeq

128133import Data.Aeson (Value)

129134import Data.ByteString (ByteString)

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

142147import GHC.OverloadedLabels

143148import GHC.TypeLits

144149import Network.IP.Addr

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

145151

146152import qualified Data.ByteString.Lazy as Lazy

147153import qualified Data.Text.Lazy as Lazy

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

810816

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

812818type 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