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

Experimental: don't try to marshal if we don't care

Browse Source 
Also explicitly test migration during deployment
This commit is contained in:
Gregor Kleen 2018-09-06 15:31:28 +02:00
parent 3bfae5d3c6
commit 66dbad9b72
2 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
db.hs
View File

@ -24,11 +24,13 @@ import Data.Time
data DBAction = DBClear data DBAction = DBClear
| DBMigrate
| DBFill | DBFill
argsDescr :: [OptDescr DBAction] argsDescr :: [OptDescr DBAction]
argsDescr = argsDescr =
[ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user" [ 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" , Option ['f'] ["fill"] (NoArg DBFill) "Fill database with example data"
] ]
@ -42,6 +44,7 @@ main = do
settings <- liftIO getAppDevSettings settings <- liftIO getAppDevSettings
withPostgresqlConn (pgConnStr $ appDatabaseConf settings) . runSqlConn $ do withPostgresqlConn (pgConnStr $ appDatabaseConf settings) . runSqlConn $ do
rawExecute "drop owned by current_user;" [] rawExecute "drop owned by current_user;" []
DBMigrate -> db $ return ()
DBFill -> db $ fillDb DBFill -> db $ fillDb
(_, _, errs) -> do (_, _, errs) -> do
forM_ errs $ hPutStrLn stderr forM_ errs $ hPutStrLn stderr

2
src/Model/Migration.hs
View File

@ -158,6 +158,6 @@ 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 PersistValue)] of
[Just _] -> return True [Just _] -> return True
_other -> return False _other -> return False