on dev help sign in
some refactoring
commit8c4beafa4445872c3f313b82f26fbd7509384e5a authorEitan Chatav <eitan@Eitans-MacBook-Pro.local> dateWed 27 Mar 2019, 09:48 (8 years ago) parent01ba5a3
1 file changed+51−32
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+51−32
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+51−32
@@ -137,19 +137,15 @@ Migrations left to run:
137137module Squeal.PostgreSQL.Migration
138138 ( -- * Migration
139139 Migration (..)
140+ , Migratory (..)
140141 , Terminally (..)
141142 , terminally
142143 , pureMigration
143− , Migratory (..)
144− -- * Migration table
144+ -- * Migrations table
145145 , MigrationsTable
146− , createMigrations
147− , insertMigration
148− , deleteMigration
149− , selectMigration
150146 -- * CLI
151147 , defaultMain
152− , MigrateCommand
148+ , MigrateCommand (..)
153149 ) where
154150
155151import Control.Category
@@ -179,27 +175,51 @@ data Migration p schemas0 schemas1 = Migration
179175 , down :: p schemas1 schemas0 -- ^ The `down` instruction of a `Migration`.
180176 } deriving (GHC.Generic)
181177
182−-- | `Terminally` turns an indexed monad transformer into a category by
183−-- restricting the return type to `()` and permuting the type variables.
178+{- |
179+A `Migratory` @p@ is a `Category` for which one can execute or rewind
180+an `AlignedList` of `Migration`s over @p@. This includes the category of pure
181+SQL `Definition`s and the category of impure `Terminally` `PQ` `IO` actions.
182+-}
183+class Category p => Migratory p where
184+
185+ {- |
186+ Run an `AlignedList` of `Migration`s.
187+ Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.
188+ In a transaction for each each `Migration`, query to see if the `Migration` has been executed;
189+ if not, execute the `Migration` and insert a row in the `MigrationsTable`.
190+ -}
191+ migrateUp
192+ :: AlignedList (Migration p) schemas0 schemas1
193+ -> PQ schemas0 schemas1 IO ()
194+
195+ {- |
196+ Rewind an `AlignedList` of `Migration`s.
197+ Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.
198+ In a transaction for each each `Migration`, query to see if the `Migration` has been executed;
199+ if so, rewind the `Migration` and delete its row in the `MigrationsTable`.
200+ -}
201+ migrateDown
202+ :: AlignedList (Migration p) schemas0 schemas1
203+ -> PQ schemas1 schemas0 IO ()
204+
205+instance Migratory Definition where
206+ migrateUp = migrateUp . alignedMap pureMigration
207+ migrateDown = migrateDown . alignedMap pureMigration
208+
209+{- | `Terminally` turns an indexed monad transformer into a category by
210+restricting the return type to `()` and permuting the type variables.
211+This is similar to how applying a monad to `()` yields a monoid.
212+Since a `Terminally` action has a trivial return value, the only reason
213+to run one is for the side effects, in particular database effects.
214+-}
184215newtype Terminally trans monad x0 x1 = Terminally
185216 { runTerminally :: trans x0 x1 monad () }
186217 deriving GHC.Generic
187218
188−-- | A `pureMigration` turns a `Migration` involving only pure SQL
189−-- `Definition`s into a `Migration` that may involve `IO`.
190−pureMigration
191− :: Migration Definition schema0 schema1
192− -> Migration (Terminally PQ IO) schema0 schema1
193−pureMigration migration = Migration
194− { name = name migration
195− , up = terminally . define $ up migration
196− , down = terminally . define $ down migration
197− }
198−
199219instance
200220 ( IndexedMonadTransPQ trans
201221 , Monad monad
202− , forall x0 x1. Monad (trans x0 x1 monad) )
222+ , forall x0 x1. x0 ~ x1 => Monad (trans x0 x1 monad) )
203223 => Category (Terminally trans monad) where
204224 id = Terminally (return ())
205225 Terminally g . Terminally f = Terminally $ pqThen g f
@@ -212,17 +232,16 @@ terminally
212232 -> Terminally trans monad x0 x1
213233terminally = Terminally . void
214234
215−class Migratory p where
216− migrateUp
217− :: AlignedList (Migration p) schemas0 schemas1
218− -> PQ schemas0 schemas1 IO ()
219− migrateDown
220− :: AlignedList (Migration p) schemas0 schemas1
221− -> PQ schemas1 schemas0 IO ()
222−
223−instance Migratory Definition where
224− migrateUp = migrateUp . alignedMap pureMigration
225− migrateDown = migrateDown . alignedMap pureMigration
235+-- | A `pureMigration` turns a `Migration` involving only pure SQL
236+-- `Definition`s into a `Migration` that may be combined with arbitrary `IO`.
237+pureMigration
238+ :: Migration Definition schema0 schema1
239+ -> Migration (Terminally PQ IO) schema0 schema1
240+pureMigration migration = Migration
241+ { name = name migration
242+ , up = terminally . define $ up migration
243+ , down = terminally . define $ down migration
244+ }
226245
227246instance Migratory (Terminally PQ IO) where
228247