Commit aff8723c authored by MrMan's avatar MrMan

Fix migration bugs

parent e51d5c3f
......@@ -158,8 +158,12 @@ makeMigrationFailedError m = pure . Left . MigrationQueryFailed from to . DT.pac
executeMigration :: Connection -> SQLMigration -> IO (Either MigrationError ())
executeMigration conn m = catch runQuery (makeMigrationFailedError m)
where
query = Query $ getMigrationQuery $ smQuery m
runQuery = withTransaction conn (execute_ conn query)
migrationQuery = Query $ getMigrationQuery $ smQuery m
versionUpdateQuery = Query $ ("PRAGMA user_version = " <>) . DT.pack . show $ getMigrationVersion $ smTo m
migrateAndUpdateVersion = execute_ conn migrationQuery
>> execute_ conn versionUpdateQuery
runQuery = withTransaction conn migrateAndUpdateVersion
>> pure (Right ())
-- | Helper function for making `VersionFetchFailed` `MigrationError`s
......@@ -172,8 +176,8 @@ getDBMigrationVersion c = catch runQuery makeVersionFetchFailedError
getVersionQuery = Query "PRAGMA user_version;" -- Happens to return 0 if never set before in SQLite
runQuery = query_ c getVersionQuery
>>= \results -> pure $ case results of
[v, _] -> Right v
[] -> Left (VersionFetchFailed "Version retrieval query returned no results")
(v:_) -> Right v
_ -> Left (VersionFetchFailed "Version retrieval query returned no results")
instance HasMigratableDB SQLiteTaskStore where
desiredVersion :: SQLiteTaskStore -> IO SQLMigrationVersion
......@@ -216,13 +220,14 @@ instance HasMigratableDB SQLiteTaskStore where
Nothing -> pure $ if current == expected then Right () else Left NoMigrationPath
-- | Perform a single migration then recur
Just m -> executeMigration conn m
>>= rightOrThrow
>> handler conn
>>= rightOrThrow
>> handler conn
-- | We are assuming monotonically increasing version numbers here, and that there exists at least
-- *one* migration between every version (i.e. v1->v2, v2->v3, etc). This is a bad assumption to make generally,
-- but I'm OK with it since this is generally how most people make migrations in my mind, implementation can change later if need be
findNextMigration ms current = find ((current+1==) . smFrom) ms
isNextStep current migration = smFrom migration == current && smTo migration == current + 1
findNextMigration migrations current = find (isNextStep current) migrations
instance Constructable SQLiteTaskStore CompleteTaskStoreConfig TaskStoreError where
construct :: CompleteTaskStoreConfig -> IO (Either TaskStoreError SQLiteTaskStore)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment