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

fix(db): prevent superfluous migrations

Browse Source
This commit is contained in:
Steffen Jost 2023-12-11 17:22:41 +01:00
parent 8b93b6a665
commit b73557a1ee
2 changed files with 4 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Model/Migration.hs
View File

@ -179,8 +179,7 @@ getMissingMigrations :: forall m m'.
=> ReaderT SqlBackend m (Map ManualMigration (ReaderT SqlBackend m' ())) => ReaderT SqlBackend m (Map ManualMigration (ReaderT SqlBackend m' ()))
getMissingMigrations = do getMissingMigrations = do
$logDebugS "Migration" "Retrieve applied migrations" $logDebugS "Migration" "Retrieve applied migrations"
appliedMigrations <- fmap (map E.unValue) . E.select . E.from $ \appliedMigration -> do appliedMigrations <- fmap (map E.unValue) . E.select . E.from $ \appliedMigration -> do
E.where_ $ appliedMigration E.^. AppliedMigrationMigration `E.in_` E.valList universeF
return $ appliedMigration E.^. AppliedMigrationMigration return $ appliedMigration E.^. AppliedMigrationMigration
return $ customMigrations `Map.withoutKeys` Set.fromList appliedMigrations return $ customMigrations `Map.withoutKeys` Set.fromList appliedMigrations

7
src/Utils/Form.hs
View File

@ -966,10 +966,9 @@ multiSelectField' optMsg mkOpts = Field{..}
fieldParse optlist _ = do fieldParse optlist _ = do
let optlist' = filter notNull optlist let optlist' = filter notNull optlist
readExternal <- view _olReadExternal <$> liftHandler mkOpts readExternal <- view _olReadExternal <$> liftHandler mkOpts
return . maybe (Left . SomeMessage $ MsgInvalidEntry $ T.intercalate ", " optlist') (Right . Just) $ mapM readExternal optlist' return $ case mapM readExternal optlist' of
-- case mapM readExternal optlist' of Nothing -> Left $ SomeMessage $ MsgInvalidEntry $ T.intercalate ", " optlist'
-- Nothing -> return $ Left $ SomeMessage $ MsgInvalidEntry $ T.intercalate ", " optlist' res -> Right res
-- res -> return $ Right res
fieldView theId name attrs val isReq = do fieldView theId name attrs val isReq = do
opts <- liftHandler mkOpts opts <- liftHandler mkOpts