fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Quotes in tableExists for Migration

Browse Source
This commit is contained in:
Gregor Kleen 2018-08-29 10:57:08 +02:00
parent c27f8b390b
commit b0cabdac15
1 changed files with 12 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/Model/Migration.hs
View File

@ -87,30 +87,19 @@ migrateAll = do
customMigrations :: MonadIO m => Map (Key AppliedMigration) (ReaderT SqlBackend m ()) customMigrations :: MonadIO m => Map (Key AppliedMigration) (ReaderT SqlBackend m ())
customMigrations = Map.fromListWith (>>) customMigrations = Map.fromListWith (>>)
[ ( AppliedMigrationKey [migrationVersion|initial|] [version|0.0.0|] [ ( AppliedMigrationKey [migrationVersion|initial|] [version|0.0.0|]
, do -- New theme format , whenM (tableExists "user") $ do -- New theme format
haveUserTable <- [sqlQQ| SELECT to_regclass('user'); |] userThemes <- [sqlQQ| SELECT 'id', 'theme' FROM 'user'; |]
forM_ userThemes $ \(uid, Single str) -> case stripPrefix "theme--" str of
case haveUserTable :: [Maybe (Single Text)] of Just v
[Just _] -> do | Just theme <- fromPathPiece v -> update uid [UserTheme =. theme]
userThemes <- [sqlQQ| SELECT 'id', 'theme' FROM 'user'; |] other -> error $ "Could not parse theme: " <> show other
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|] , ( AppliedMigrationKey [migrationVersion|0.0.0|] [version|1.0.0|]
, do -- Better JSON encoding , whenM (tableExists "sheet") $ -- Better JSON encoding
[executeQQ|
haveSheetTable <- [sqlQQ| SELECT to_regclass('sheet'); |] ALTER TABLE 'sheet' ALTER COLUMN 'type' TYPE json USING 'type'::json;
ALTER TABLE 'sheet' ALTER COLUMN 'grouping' TYPE json USING 'grouping'::json;
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 ()
) )
, ( AppliedMigrationKey [migrationVersion|1.0.0|] [version|2.0.0|] , ( AppliedMigrationKey [migrationVersion|1.0.0|] [version|2.0.0|]
, whenM (tableExists "school") $ do -- SchoolId is the Shorthand CI Text now , whenM (tableExists "school") $ do -- SchoolId is the Shorthand CI Text now
@ -168,7 +157,7 @@ customMigrations = Map.fromListWith (>>)
tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool
tableExists table = do tableExists table = do
haveSchoolTable <- [sqlQQ| SELECT to_regclass(#{table}); |] haveSchoolTable <- [sqlQQ| SELECT to_regclass('#{table}'); |]
case haveSchoolTable :: [Maybe (Single Text)] of case haveSchoolTable :: [Maybe (Single Text)] of
[Just _] -> return True [Just _] -> return True
_other -> return False _other -> return False