diff --git a/db.hs b/db.hs index 5cac10dfa..0c254a588 100755 --- a/db.hs +++ b/db.hs @@ -24,12 +24,14 @@ import Data.Time data DBAction = DBClear + | DBMigrate | DBFill argsDescr :: [OptDescr DBAction] argsDescr = - [ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user" - , Option ['f'] ["fill"] (NoArg DBFill) "Fill database with example data" + [ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user" + , Option ['m'] ["migrate"] (NoArg DBMigrate) "Perform database migration" + , Option ['f'] ["fill"] (NoArg DBFill) "Fill database with example data" ] @@ -38,11 +40,12 @@ main = do args <- map unpack <$> getArgs case getOpt Permute argsDescr args of (acts@(_:_), [], []) -> forM_ acts $ \case - DBClear -> runStderrLoggingT $ do -- We don't use `db` here, since we do /not/ want any migrations to run, yet + DBClear -> runStderrLoggingT $ do -- We don't use `db` here, since we do /not/ want any migrations to run, yet settings <- liftIO getAppDevSettings withPostgresqlConn (pgConnStr $ appDatabaseConf settings) . runSqlConn $ do rawExecute "drop owned by current_user;" [] - DBFill -> db $ fillDb + DBMigrate -> db $ return () + DBFill -> db $ fillDb (_, _, errs) -> do forM_ errs $ hPutStrLn stderr hPutStrLn stderr $ usageInfo "db.hs" argsDescr diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index a47a435d2..8d16d1d1e 100644 --- a/src/Model/Migration.hs +++ b/src/Model/Migration.hs @@ -158,6 +158,6 @@ customMigrations = Map.fromListWith (>>) tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool tableExists table = do haveSchoolTable <- [sqlQQ| SELECT to_regclass(#{table}); |] - case haveSchoolTable :: [Maybe (Single Text)] of + case haveSchoolTable :: [Maybe (Single PersistValue)] of [Just _] -> return True _other -> return False