cffa382 · squeal · git.iko.soy

git.iko.soy/squeal

factor out free categories

commitcffa382f7525464384df203e43760007acc5448f authorEitan Chatav <eitan@EEM109LMBP-1.local> dateMon 16 Sep 2019, 20:11 (7 years ago) parentccc4620

6 files changed+28−25

compare with dev

unifiedsplit

squeal-postgresql/squeal-postgresql.cabal+1 squeal-postgresql/src/Squeal/PostgreSQL/List.hs+8−8 squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+12−12 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+4−4 stack.yaml+2

squeal-postgresql/squeal-postgresql.cabal+1

@@ -63,6 +63,7 @@ library

6363 , bytestring >= 0.10.8.2

6464 , bytestring-strict-builder >= 0.4.5

6565 , deepseq >= 1.4.3.0

66+ , free-categories >= 0.1.0.0

6667 , generics-sop >= 0.3.2.0 && < 0.5.0.0

6768 , mmorph >= 1.1.1

6869 , mtl >= 2.2.2

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

@@ -30,19 +30,19 @@ lists and type aligned lists.

3030module Squeal.PostgreSQL.List

3131 ( SOP.NP (..)

3232 , (*:)

33+ , Path (..)

34+ , CFunctor (..)

35+ , CFoldable (..)

36+ , CFree (..)

3337 , Join

3438 , disjoin

3539 , Additional (..)

36− , AlignedList (..)

37− , single

38− , extractList

39− , mapAligned

4040 , Elem

4141 , In

4242 , Length

4343 ) where

4444

45−import Control.Category

45+import Control.Category.Free

4646import Data.Function ((&))

4747import Data.Kind

4848import Data.Type.Bool

@@ -50,7 +50,7 @@ import GHC.TypeLits

5050

5151import Generics.SOP as SOP

5252

53−import Squeal.PostgreSQL.Render

53+-- import Squeal.PostgreSQL.Render

5454

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

5656-- `Squeal.PostgreSQL.Query.FromClause`s.

@@ -77,7 +77,7 @@ instance Additional (NP expr) where

7777 also ys = \case

7878 Nil -> ys

7979 x :* xs -> x :* (xs & also ys)

80−

80+{-

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

8282data AlignedList p x0 x1 where

8383 Done :: AlignedList p x x

@@ -113,7 +113,7 @@ mapAligned f = \case

113113-- | A `single` step.

114114single :: p x0 x1 -> AlignedList p x0 x1

115115single step = step :>> Done

116−

116+-}

117117-- | A useful operator for ending an `NP` list of length at least 2 without `Nil`.

118118(*:) :: f x -> f y -> NP f '[x,y]

119119x *: y = x :* y :* Nil

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

@@ -99,7 +99,7 @@ instance RenderSQL (Manipulation commons schemas params columns) where

9999instance With Manipulation where

100100 with Done manip = manip

101101 with ctes manip = UnsafeManipulation $

102− "WITH" <+> renderSQL ctes <+> renderSQL manip

102+ "WITH" <+> commaSeparated (ctoList renderSQL ctes) <+> renderSQL manip

103103

104104{- |

105105The top level `Manipulation_` type is parameterized by a @schemas@ `SchemasType`,

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+12−12

@@ -66,7 +66,7 @@ let

6666 }

6767:}

6868

69−Now that we have a couple migrations we can chain them together into an `AlignedList`.

69+Now that we have a couple migrations we can chain them together into a `Path`.

7070

7171>>> let migrations = makeUsers :>> makeEmails :>> Done

7272

@@ -190,34 +190,34 @@ data Migration p schemas0 schemas1 = Migration

190190

191191{- |

192192A `Migratory` @p@ is a `Category` for which one can execute or rewind

193−an `AlignedList` of `Migration`s over @p@. This includes the category of pure

193+a `Path` of `Migration`s over @p@. This includes the category of pure

194194SQL `Definition`s and the category of impure `Terminally` `PQ` `IO` actions.

195195-}

196196class Category p => Migratory p where

197197

198198 {- |

199− Run an `AlignedList` of `Migration`s.

199+ Run a `Path` of `Migration`s.

200200 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.

201201 In one transaction, for each each `Migration` query to see if the `Migration` has been executed;

202202 if not, `up` the `Migration` and insert its `name` in the `MigrationsTable`.

203203 -}

204204 migrateUp

205− :: AlignedList (Migration p) schemas0 schemas1

205+ :: Path (Migration p) schemas0 schemas1

206206 -> PQ schemas0 schemas1 IO ()

207207

208208 {- |

209− Rewind an `AlignedList` of `Migration`s.

209+ Rewind a `Path` of `Migration`s.

210210 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.

211211 In one transaction, for each each `Migration` query to see if the `Migration` has been executed;

212212 if so, `down` the `Migration` and delete its `name` in the `MigrationsTable`.

213213 -}

214214 migrateDown

215− :: AlignedList (Migration p) schemas0 schemas1

215+ :: Path (Migration p) schemas0 schemas1

216216 -> PQ schemas1 schemas0 IO ()

217217

218218instance Migratory Definition where

219− migrateUp = migrateUp . mapAligned pureMigration

220− migrateDown = migrateDown . mapAligned pureMigration

219+ migrateUp = migrateUp . cmap pureMigration

220+ migrateDown = migrateDown . cmap pureMigration

221221

222222{- | `Terminally` turns an indexed monad transformer and the monad it transforms

223223into a category by restricting the return type to @()@ and permuting the type variables.

@@ -266,7 +266,7 @@ instance Migratory (Terminally PQ IO) where

266266 where

267267

268268 upMigrations

269− :: AlignedList (Migration (Terminally PQ IO)) schemas0 schemas1

269+ :: Path (Migration (Terminally PQ IO)) schemas0 schemas1

270270 -> PQ MigrationsSchemas MigrationsSchemas IO ()

271271 upMigrations = \case

272272 Done -> return ()

@@ -295,7 +295,7 @@ instance Migratory (Terminally PQ IO) where

295295 where

296296

297297 downMigrations

298− :: AlignedList (Migration (Terminally PQ IO)) schemas0 schemas1

298+ :: Path (Migration (Terminally PQ IO)) schemas0 schemas1

299299 -> PQ MigrationsSchemas MigrationsSchemas IO ()

300300 downMigrations = \case

301301 Done -> return ()

@@ -382,7 +382,7 @@ defaultMain

382382 :: Migratory p

383383 => ByteString

384384 -- ^ connection string

385− -> AlignedList (Migration p) db0 db1

385+ -> Path (Migration p) db0 db1

386386 -- ^ migrations

387387 -> IO ()

388388defaultMain connectTo migrations = do

@@ -403,7 +403,7 @@ defaultMain connectTo migrations = do

403403 migrateStatus :: PQ schema schema IO ()

404404 migrateStatus = unsafePQ $ do

405405 runNames <- getRunMigrationNames

406− let names = extractList name migrations

406+ let names = ctoList name migrations

407407 unrunNames = names \\ runNames

408408 liftIO $ displayRunned runNames >> displayUnrunned unrunNames

409409

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+4−4

@@ -1041,8 +1041,8 @@ instance

10411041 , commons1 ~ (cte ::: common ': commons)

10421042 ) => Aliasable cte

10431043 (statement commons schemas params common)

1044− (AlignedList (CommonTableExpression statement schemas params) commons commons1) where

1045− statement `as` cte = single (statement `as` cte)

1044+ (Path (CommonTableExpression statement schemas params) commons commons1) where

1045+ statement `as` cte = csingleton (statement `as` cte)

10461046

10471047instance (forall c s p r. RenderSQL (statement c s p r)) => RenderSQL

10481048 (CommonTableExpression statement schemas params commons0 commons1) where

@@ -1054,7 +1054,7 @@ instance (forall c s p r. RenderSQL (statement c s p r)) => RenderSQL

10541054-- defining temporary tables that exist just for one query.

10551055class With statement where

10561056 with

1057− :: AlignedList (CommonTableExpression statement schemas params) commons0 commons1

1057+ :: Path (CommonTableExpression statement schemas params) commons0 commons1

10581058 -- ^ common table expressions

10591059 -> statement commons1 schemas params row

10601060 -- ^ larger query

@@ -1062,7 +1062,7 @@ class With statement where

10621062instance With (Query outer) where

10631063 with Done query = query

10641064 with ctes query = UnsafeQuery $

1065− "WITH" <+> renderSQL ctes <+> renderSQL query

1065+ "WITH" <+> commaSeparated (ctoList renderSQL ctes) <+> renderSQL query

10661066

10671067{- |

10681068>>> import Data.Monoid (Sum (..))

stack.yaml+2

@@ -4,3 +4,5 @@ packages:

55extra-deps:

66- unliftio-pool-0.2.1.0

7+- github: morphismtech/free-categories

8+ commit: c31d305a06477771e3cdac4a61d45cb8718a453c