git.iko.soy/squeal
on dev help sign in
factor out free categories
cffa382Eitan Chatav
squeal-postgresql/squeal-postgresql.cabal+1
compare with dev
unifiedsplit
@@ -63,6 +63,7 @@ library
63 , bytestring >= 0.10.8.2
63 , bytestring >= 0.10.8.2
64 , bytestring-strict-builder >= 0.4.5
64 , bytestring-strict-builder >= 0.4.5
65 , deepseq >= 1.4.3.0
65 , deepseq >= 1.4.3.0
66+ , free-categories >= 0.1.0.0
66 , generics-sop >= 0.3.2.0 && < 0.5.0.0
67 , generics-sop >= 0.3.2.0 && < 0.5.0.0
67 , mmorph >= 1.1.1
68 , mmorph >= 1.1.1
68 , mtl >= 2.2.2
69 , mtl >= 2.2.2
squeal-postgresql/src/Squeal/PostgreSQL/List.hs+8−8
@@ -30,19 +30,19 @@ lists and type aligned lists.
30module Squeal.PostgreSQL.List
30module Squeal.PostgreSQL.List
31 ( SOP.NP (..)
31 ( SOP.NP (..)
32 , (*:)
32 , (*:)
33+ , Path (..)
34+ , CFunctor (..)
35+ , CFoldable (..)
36+ , CFree (..)
33 , Join
37 , Join
34 , disjoin
38 , disjoin
35 , Additional (..)
39 , Additional (..)
36− , AlignedList (..)
37− , single
38− , extractList
39− , mapAligned
40 , Elem
40 , Elem
41 , In
41 , In
42 , Length
42 , Length
43 ) where
43 ) where
44
44
45−import Control.Category
45+import Control.Category.Free
46import Data.Function ((&))
46import Data.Function ((&))
47import Data.Kind
47import Data.Kind
48import Data.Type.Bool
48import Data.Type.Bool
@@ -50,7 +50,7 @@ import GHC.TypeLits
50
50
51import Generics.SOP as SOP
51import Generics.SOP as SOP
52
52
53−import Squeal.PostgreSQL.Render
53+-- import Squeal.PostgreSQL.Render
54
54
55-- | `Join` is simply promoted `++` and is used in @JOIN@s in
55-- | `Join` is simply promoted `++` and is used in @JOIN@s in
56-- `Squeal.PostgreSQL.Query.FromClause`s.
56-- `Squeal.PostgreSQL.Query.FromClause`s.
@@ -77,7 +77,7 @@ instance Additional (NP expr) where
77 also ys = \case
77 also ys = \case
78 Nil -> ys
78 Nil -> ys
79 x :* xs -> x :* (xs & also ys)
79 x :* xs -> x :* (xs & also ys)
80−
80+{-
81-- | An `AlignedList` is a type-aligned list or free category.
81-- | An `AlignedList` is a type-aligned list or free category.
82data AlignedList p x0 x1 where
82data AlignedList p x0 x1 where
83 Done :: AlignedList p x x
83 Done :: AlignedList p x x
@@ -113,7 +113,7 @@ mapAligned f = \case
113-- | A `single` step.
113-- | A `single` step.
114single :: p x0 x1 -> AlignedList p x0 x1
114single :: p x0 x1 -> AlignedList p x0 x1
115single step = step :>> Done
115single step = step :>> Done
116−
116+-}
117-- | A useful operator for ending an `NP` list of length at least 2 without `Nil`.
117-- | A useful operator for ending an `NP` list of length at least 2 without `Nil`.
118(*:) :: f x -> f y -> NP f '[x,y]
118(*:) :: f x -> f y -> NP f '[x,y]
119x *: y = x :* y :* Nil
119x *: 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
99instance With Manipulation where
99instance With Manipulation where
100 with Done manip = manip
100 with Done manip = manip
101 with ctes manip = UnsafeManipulation $
101 with ctes manip = UnsafeManipulation $
102− "WITH" <+> renderSQL ctes <+> renderSQL manip
102+ "WITH" <+> commaSeparated (ctoList renderSQL ctes) <+> renderSQL manip
103
103
104{- |
104{- |
105The top level `Manipulation_` type is parameterized by a @schemas@ `SchemasType`,
105The top level `Manipulation_` type is parameterized by a @schemas@ `SchemasType`,
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+12−12
@@ -66,7 +66,7 @@ let
66 }
66 }
67:}
67:}
68
68
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`.
70
70
71>>> let migrations = makeUsers :>> makeEmails :>> Done
71>>> let migrations = makeUsers :>> makeEmails :>> Done
72
72
@@ -190,34 +190,34 @@ data Migration p schemas0 schemas1 = Migration
190
190
191{- |
191{- |
192A `Migratory` @p@ is a `Category` for which one can execute or rewind
192A `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
194SQL `Definition`s and the category of impure `Terminally` `PQ` `IO` actions.
194SQL `Definition`s and the category of impure `Terminally` `PQ` `IO` actions.
195-}
195-}
196class Category p => Migratory p where
196class Category p => Migratory p where
197
197
198 {- |
198 {- |
199− Run an `AlignedList` of `Migration`s.
199+ Run a `Path` of `Migration`s.
200 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.
200 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.
201 In one transaction, for each each `Migration` query to see if the `Migration` has been executed;
201 In one transaction, for each each `Migration` query to see if the `Migration` has been executed;
202 if not, `up` the `Migration` and insert its `name` in the `MigrationsTable`.
202 if not, `up` the `Migration` and insert its `name` in the `MigrationsTable`.
203 -}
203 -}
204 migrateUp
204 migrateUp
205− :: AlignedList (Migration p) schemas0 schemas1
205+ :: Path (Migration p) schemas0 schemas1
206 -> PQ schemas0 schemas1 IO ()
206 -> PQ schemas0 schemas1 IO ()
207
207
208 {- |
208 {- |
209− Rewind an `AlignedList` of `Migration`s.
209+ Rewind a `Path` of `Migration`s.
210 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.
210 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.
211 In one transaction, for each each `Migration` query to see if the `Migration` has been executed;
211 In one transaction, for each each `Migration` query to see if the `Migration` has been executed;
212 if so, `down` the `Migration` and delete its `name` in the `MigrationsTable`.
212 if so, `down` the `Migration` and delete its `name` in the `MigrationsTable`.
213 -}
213 -}
214 migrateDown
214 migrateDown
215− :: AlignedList (Migration p) schemas0 schemas1
215+ :: Path (Migration p) schemas0 schemas1
216 -> PQ schemas1 schemas0 IO ()
216 -> PQ schemas1 schemas0 IO ()
217
217
218instance Migratory Definition where
218instance Migratory Definition where
219− migrateUp = migrateUp . mapAligned pureMigration
219+ migrateUp = migrateUp . cmap pureMigration
220− migrateDown = migrateDown . mapAligned pureMigration
220+ migrateDown = migrateDown . cmap pureMigration
221
221
222{- | `Terminally` turns an indexed monad transformer and the monad it transforms
222{- | `Terminally` turns an indexed monad transformer and the monad it transforms
223into a category by restricting the return type to @()@ and permuting the type variables.
223into a category by restricting the return type to @()@ and permuting the type variables.
@@ -266,7 +266,7 @@ instance Migratory (Terminally PQ IO) where
266 where
266 where
267
267
268 upMigrations
268 upMigrations
269− :: AlignedList (Migration (Terminally PQ IO)) schemas0 schemas1
269+ :: Path (Migration (Terminally PQ IO)) schemas0 schemas1
270 -> PQ MigrationsSchemas MigrationsSchemas IO ()
270 -> PQ MigrationsSchemas MigrationsSchemas IO ()
271 upMigrations = \case
271 upMigrations = \case
272 Done -> return ()
272 Done -> return ()
@@ -295,7 +295,7 @@ instance Migratory (Terminally PQ IO) where
295 where
295 where
296
296
297 downMigrations
297 downMigrations
298− :: AlignedList (Migration (Terminally PQ IO)) schemas0 schemas1
298+ :: Path (Migration (Terminally PQ IO)) schemas0 schemas1
299 -> PQ MigrationsSchemas MigrationsSchemas IO ()
299 -> PQ MigrationsSchemas MigrationsSchemas IO ()
300 downMigrations = \case
300 downMigrations = \case
301 Done -> return ()
301 Done -> return ()
@@ -382,7 +382,7 @@ defaultMain
382 :: Migratory p
382 :: Migratory p
383 => ByteString
383 => ByteString
384 -- ^ connection string
384 -- ^ connection string
385− -> AlignedList (Migration p) db0 db1
385+ -> Path (Migration p) db0 db1
386 -- ^ migrations
386 -- ^ migrations
387 -> IO ()
387 -> IO ()
388defaultMain connectTo migrations = do
388defaultMain connectTo migrations = do
@@ -403,7 +403,7 @@ defaultMain connectTo migrations = do
403 migrateStatus :: PQ schema schema IO ()
403 migrateStatus :: PQ schema schema IO ()
404 migrateStatus = unsafePQ $ do
404 migrateStatus = unsafePQ $ do
405 runNames <- getRunMigrationNames
405 runNames <- getRunMigrationNames
406− let names = extractList name migrations
406+ let names = ctoList name migrations
407 unrunNames = names \\ runNames
407 unrunNames = names \\ runNames
408 liftIO $ displayRunned runNames >> displayUnrunned unrunNames
408 liftIO $ displayRunned runNames >> displayUnrunned unrunNames
409
409
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+4−4
@@ -1041,8 +1041,8 @@ instance
1041 , commons1 ~ (cte ::: common ': commons)
1041 , commons1 ~ (cte ::: common ': commons)
1042 ) => Aliasable cte
1042 ) => Aliasable cte
1043 (statement commons schemas params common)
1043 (statement commons schemas params common)
1044− (AlignedList (CommonTableExpression statement schemas params) commons commons1) where
1044+ (Path (CommonTableExpression statement schemas params) commons commons1) where
1045− statement `as` cte = single (statement `as` cte)
1045+ statement `as` cte = csingleton (statement `as` cte)
1046
1046
1047instance (forall c s p r. RenderSQL (statement c s p r)) => RenderSQL
1047instance (forall c s p r. RenderSQL (statement c s p r)) => RenderSQL
1048 (CommonTableExpression statement schemas params commons0 commons1) where
1048 (CommonTableExpression statement schemas params commons0 commons1) where
@@ -1054,7 +1054,7 @@ instance (forall c s p r. RenderSQL (statement c s p r)) => RenderSQL
1054-- defining temporary tables that exist just for one query.
1054-- defining temporary tables that exist just for one query.
1055class With statement where
1055class With statement where
1056 with
1056 with
1057− :: AlignedList (CommonTableExpression statement schemas params) commons0 commons1
1057+ :: Path (CommonTableExpression statement schemas params) commons0 commons1
1058 -- ^ common table expressions
1058 -- ^ common table expressions
1059 -> statement commons1 schemas params row
1059 -> statement commons1 schemas params row
1060 -- ^ larger query
1060 -- ^ larger query
@@ -1062,7 +1062,7 @@ class With statement where
1062instance With (Query outer) where
1062instance With (Query outer) where
1063 with Done query = query
1063 with Done query = query
1064 with ctes query = UnsafeQuery $
1064 with ctes query = UnsafeQuery $
1065− "WITH" <+> renderSQL ctes <+> renderSQL query
1065+ "WITH" <+> commaSeparated (ctoList renderSQL ctes) <+> renderSQL query
1066
1066
1067{- |
1067{- |
1068>>> import Data.Monoid (Sum (..))
1068>>> import Data.Monoid (Sum (..))
stack.yaml+2
@@ -4,3 +4,5 @@ packages:
4
4
5extra-deps:
5extra-deps:
6- unliftio-pool-0.2.1.0
6- unliftio-pool-0.2.1.0
7+- github: morphismtech/free-categories
8+ commit: c31d305a06477771e3cdac4a61d45cb8718a453c