Fix database migrations for empty db

Fixes #159
This commit is contained in:
Gregor Kleen 2018-08-14 20:35:18 +02:00
parent 7671d68592
commit 13cc4195c8

View File

@ -79,16 +79,27 @@ customMigrations :: MonadIO m => Map (Key AppliedMigration) (ReaderT SqlBackend
customMigrations = Map.fromListWith (>>)
[ ( AppliedMigrationKey [migrationVersion|initial|] [version|0.0.0|]
, do -- New theme format
userThemes <- [sqlQQ| SELECT @{UserId}, @{UserTheme} FROM ^{User}; |]
forM_ userThemes $ \(uid, Single str) -> case stripPrefix "theme--" str of
Just v
| Just theme <- fromPathPiece v -> update uid [UserTheme =. theme]
other -> error $ "Could not parse theme: " <> show other
haveUserTable <- [sqlQQ| SELECT to_regclass('user'); |]
case haveUserTable :: [Maybe (Single Text)] of
[Just _] -> do
userThemes <- [sqlQQ| SELECT 'id', 'theme' FROM 'user'; |]
forM_ userThemes $ \(uid, Single str) -> case stripPrefix "theme--" str of
Just v
| Just theme <- fromPathPiece v -> update uid [UserTheme =. theme]
other -> error $ "Could not parse theme: " <> show other
_other -> return ()
)
, ( AppliedMigrationKey [migrationVersion|0.0.0|] [version|1.0.0|]
, [executeQQ| -- Better JSON encoding
ALTER TABLE "sheet" ALTER COLUMN "type" TYPE json USING "type"::json;
ALTER TABLE "sheet" ALTER COLUMN "grouping" TYPE json USING "grouping"::json;
|]
, do -- Better JSON encoding
haveSheetTable <- [sqlQQ| SELECT to_regclass('sheet'); |]
case haveSheetTable :: [Maybe (Single Text)] of
[Just _] ->
[executeQQ|
ALTER TABLE 'sheet' ALTER COLUMN 'type' TYPE json USING 'type'::json;
ALTER TABLE 'sheet' ALTER COLUMN 'grouping' TYPE json USING 'grouping'::json;
|]
_other -> return ()
)
]