git.iko.soy/squeal
on dev help sign in
migration refactoring and documentation
654ef62Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+124−57
compare with dev
unifiedsplit
@@ -11,11 +11,13 @@
11#-}
11#-}
12
12
13module Squeal.PostgreSQL.Migration
13module Squeal.PostgreSQL.Migration
14− ( Migration (..)
14+ ( -- * Migration
15− , Step (..)
15+ Migration (..)
16− , skip
17 , migrateUp
16 , migrateUp
18 , migrateDown
17 , migrateDown
18+ -- * Step
19+ , Step (..)
20+ -- * MigrationTable
19 , MigrationTable
21 , MigrationTable
20 , createMigration
22 , createMigration
21 , insertStep
23 , insertStep
@@ -29,19 +31,22 @@ import Control.Monad.Base
29import Control.Monad.Trans.Control
31import Control.Monad.Trans.Control
30import Generics.SOP (K(..))
32import Generics.SOP (K(..))
31import Data.Function ((&))
33import Data.Function ((&))
34+import Data.Text (Text)
32import Prelude hiding (id, (.))
35import Prelude hiding (id, (.))
33
36
34import Squeal.PostgreSQL
37import Squeal.PostgreSQL
35import Squeal.PostgreSQL.Transaction
38import Squeal.PostgreSQL.Transaction
36
39
40+-- | A `Step` of a `Migration`, should contain an inverse pair of
41+-- `up` and `down` instructions.
37data Step io schema0 schema1 = Step
42data Step io schema0 schema1 = Step
43+ { name :: Text -- ^ The `name` of a `Step`.
44+ -- Each `name` in a `Migration` should be unique.
38− { up :: PQ schema0 schema1 io ()
45+ , up :: PQ schema0 schema1 io () -- ^ The `up` instruction of a `Step`.
39− , down :: PQ schema1 schema0 io ()
46+ , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Step`.
40 }
47 }
41
48
42−skip :: Monad io => Step io schema schema -> Step io schema schema
49+-- | A `Migration` is a chain of `Step`s
43−skip _ = Step (return ()) (return ())
44−
45data Migration io schema0 schema1 where
50data Migration io schema0 schema1 where
46 Done :: Migration io schema schema
51 Done :: Migration io schema schema
47 (:>>)
52 (:>>)
@@ -55,28 +60,126 @@ instance Category (Migration io) where
55 Done -> migration
60 Done -> migration
56 step :>> steps -> step :>> (steps >>> migration)
61 step :>> steps -> step :>> (steps >>> migration)
57
62
63+
64+-- | Run a `Migration` by creating the `MigrationTable`
65+-- if it does not exist and then for each each `Step`
66+-- query to see if the `Step` is executed. If not, then
67+-- execute the `Step` and insert its row in `MigrationTable`.
58migrateUp
68migrateUp
59 :: MonadBaseControl IO io
69 :: MonadBaseControl IO io
60− => Migration io schema0 schema1 -> PQ
70+ => Migration io schema0 schema1 -- ^ migration to run
71+ -> PQ
61 ("migration" ::: MigrationTable ': schema0)
72 ("migration" ::: MigrationTable ': schema0)
62 ("migration" ::: MigrationTable ': schema1)
73 ("migration" ::: MigrationTable ': schema1)
63 io ()
74 io ()
64−migrateUp migration = start & pqThen (upSteps migration & pqBind end)
75+migrateUp migration =
65−
76+ define createMigration
77+ & pqThen (begin (TransactionMode RepeatableRead ReadWrite))
78+ & pqThen (upSteps migration)
79+ & pqThen (void commit)
80+ where
81+
82+ upSteps
83+ :: MonadBaseControl IO io
84+ => Migration io schema0 schema1
85+ -> PQ
86+ ("migration" ::: MigrationTable ': schema0)
87+ ("migration" ::: MigrationTable ': schema1)
88+ io ()
89+ upSteps = \case
90+ Done -> return ()
91+ step :>> steps -> onExceptionRollback $
92+ upStep step
93+ & pqThen (upSteps steps)
94+
95+ queryExecuted
96+ :: MonadBase IO io
97+ => Step io schema0 schema1 -> PQ
98+ ("migration" ::: MigrationTable ': schema0)
99+ ("migration" ::: MigrationTable ': schema0)
100+ io RowNumber
101+ queryExecuted =
102+ ntuples <=< runQueryParams selectStep . Only . name
103+
104+ upStep
105+ :: MonadBase IO io
106+ => Step io schema0 schema1 -> PQ
107+ ("migration" ::: MigrationTable ': schema0)
108+ ("migration" ::: MigrationTable ': schema1)
109+ io ()
110+ upStep step =
111+ queryExecuted step
112+ & pqBind (\ (RowNumber executed) ->
113+ if executed == 1 -- up step has already been executed
114+ then PQ (\ _ -> return (K ())) -- unsafely switch schemas
115+ else
116+ pqEmbed (up step) -- safely switch schemas
117+ & pqThen (manipulateParams insertStep (Only (name step)) & void))
118+ -- insert up step execution record
119+
120+-- | Rewind a `Migration` by creating the `MigrationTable`
121+-- if it does not exist and then for each each `Step`
122+-- query to see if the `Step` is executed. If it is, then
123+-- rewind the `Step` and delete its row in `MigrationTable`.
66migrateDown
124migrateDown
67 :: MonadBaseControl IO io
125 :: MonadBaseControl IO io
68− => Migration io schema0 schema1 -> PQ
126+ => Migration io schema0 schema1 -- ^ migration to rewind
127+ -> PQ
69− ("migration" ::: MigrationTable ': schema1)
128+ ("migration" ::: MigrationTable ': schema1)
70− ("migration" ::: MigrationTable ': schema0)
129+ ("migration" ::: MigrationTable ': schema0)
71− io ()
130+ io ()
131+migrateDown migration =
132+ define createMigration
133+ & pqThen (begin (TransactionMode RepeatableRead ReadWrite) & void)
72−migrateDown migration = start & pqThen (downSteps migration & pqBind end)
134+ & pqThen (downSteps migration)
73−
135+ & pqThen (void commit)
136+ where
137+
138+ queryExecuted
139+ :: MonadBase IO io
140+ => Step io schema0 schema1 -> PQ
141+ ("migration" ::: MigrationTable ': schema1)
142+ ("migration" ::: MigrationTable ': schema1)
143+ io RowNumber
144+ queryExecuted =
145+ ntuples <=< runQueryParams selectStep . Only . name
146+
147+ downStep
148+ :: MonadBase IO io
149+ => Step io schema0 schema1 -> PQ
150+ ("migration" ::: MigrationTable ': schema1)
151+ ("migration" ::: MigrationTable ': schema0)
152+ io ()
153+ downStep step =
154+ queryExecuted step
155+ & pqBind (\ (RowNumber executed) ->
156+ if executed == 0 -- up step has not been executed
157+ then PQ (\ _ -> return (K ())) -- unsafely switch schemas
158+ else
159+ pqEmbed (down step) -- safely switch schemas
160+ & pqThen (manipulateParams deleteStep (Only (name step)) & void))
161+ -- delete up step execution record
162+
163+ downSteps
164+ :: MonadBaseControl IO io
165+ => Migration io schema0 schema1 -> PQ
166+ ("migration" ::: MigrationTable ': schema1)
167+ ("migration" ::: MigrationTable ': schema0)
168+ io ()
169+ downSteps = \case
170+ Done -> return ()
171+ step :>> steps -> onExceptionRollback $
172+ downSteps steps
173+ & pqThen (downStep step)
174+
175+-- | The `TableType` for a Squeal migration.
74type MigrationTable =
176type MigrationTable =
75 '[ "unique_name" ::: 'Unique '["name"]] :=>
177 '[ "unique_name" ::: 'Unique '["name"]] :=>
76 '[ "name" ::: 'NoDef :=> 'NotNull 'PGtext
178 '[ "name" ::: 'NoDef :=> 'NotNull 'PGtext
77 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
179 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
78 ]
180 ]
79
181
182+-- | Creates a `MigrationTable` if it does not already exist.
80createMigration
183createMigration
81 :: Has "migration" schema MigrationTable
184 :: Has "migration" schema MigrationTable
82 => Definition schema schema
185 => Definition schema schema
@@ -87,6 +190,7 @@ createMigration =
87 `As` #executed_at :* Nil )
190 `As` #executed_at :* Nil )
88 ( unique (Column #name :* Nil) `As` #unique_name :* Nil )
191 ( unique (Column #name :* Nil) `As` #unique_name :* Nil )
89
192
193+-- | Inserts a `Step` into the `MigrationTable`
90insertStep
194insertStep
91 :: Has "migration" schema MigrationTable
195 :: Has "migration" schema MigrationTable
92 => Manipulation schema '[ 'NotNull 'PGtext] '[]
196 => Manipulation schema '[ 'NotNull 'PGtext] '[]
@@ -94,11 +198,14 @@ insertStep = insertRow_ #migration
94 ( Set (param @1) `As` #name :*
198 ( Set (param @1) `As` #name :*
95 Default `As` #executed_at :* Nil )
199 Default `As` #executed_at :* Nil )
96
200
201+-- | Deletes a `Step` from the `MigrationTable`
97deleteStep
202deleteStep
98 :: Has "migration" schema MigrationTable
203 :: Has "migration" schema MigrationTable
99 => Manipulation schema '[ 'NotNull 'PGtext ] '[]
204 => Manipulation schema '[ 'NotNull 'PGtext ] '[]
100deleteStep = deleteFrom_ #migration (#name .== param @1)
205deleteStep = deleteFrom_ #migration (#name .== param @1)
101
206
207+-- | Selects a `Step` from the `MigrationTable`, returning
208+-- the time at which it was executed.
102selectStep
209selectStep
103 :: Has "migration" schema MigrationTable
210 :: Has "migration" schema MigrationTable
104 => Query schema '[ 'NotNull 'PGtext ]
211 => Query schema '[ 'NotNull 'PGtext ]
@@ -107,43 +214,3 @@ selectStep = select
107 (#executed_at `As` #executed_at :* Nil)
214 (#executed_at `As` #executed_at :* Nil)
108 ( from (table (#migration `As` #m))
215 ( from (table (#migration `As` #m))
109 & where_ (#name .== param @1))
216 & where_ (#name .== param @1))
110−
111−start
112− :: MonadBase IO io => PQ
113− ("migration" ::: MigrationTable ': schema)
114− ("migration" ::: MigrationTable ': schema)
115− io ()
116−start = define createMigration
117− & pqThen (begin (TransactionMode RepeatableRead ReadWrite) & void)
118−
119−upSteps
120− :: MonadBaseControl IO io
121− => Migration io schema0 schema1
122− -> PQ
123− ("migration" ::: MigrationTable ': schema0)
124− ("migration" ::: MigrationTable ': schema1)
125− io ()
126−upSteps = \case
127− Done -> return ()
128− step :>> steps -> onExceptionRollback $
129− pqEmbed (up step) & pqThen (upSteps steps)
130−
131−downSteps
132− :: MonadBaseControl IO io
133− => Migration io schema0 schema1 -> PQ
134− ("migration" ::: MigrationTable ': schema1)
135− ("migration" ::: MigrationTable ': schema0)
136− io ()
137−downSteps = \case
138− Done -> return ()
139− step :>> steps -> onExceptionRollback $
140− downSteps steps & pqThen (pqEmbed (down step))
141−
142−end :: MonadBase IO io => result -> PQ
143− ("migration" ::: MigrationTable ': schema)
144− ("migration" ::: MigrationTable ': schema)
145− io result
146−end result = commit >> return result
147−
148−avoid :: Monad m => PQ schema0 schema1 m ()
149−avoid = PQ $ \ _ -> return (K ())