diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 8448ea1e2..d3e91f601 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -446,6 +446,7 @@ RedundantCandidatesRemoved n@Int: #{show n} bereits #{pluralDE n "bekannter Kand CandidatesInferred n@Int: #{show n} neue #{pluralDE n "Studiengangszuordnung" "Studiengangszuordnungen"} inferiert NoCandidatesInferred: Keine neuen Studienganszuordnungen inferiert StudyTermIsNew: Neu +StudyFeatureConflict: Es wurden Konflikte in der Studiengang-Zuordnung gefunden MailTestFormEmail: Email-Addresse MailTestFormLanguages: Spracheinstellungen diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 187392b7a..a497edf11 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -288,24 +288,28 @@ postAdminFeaturesR = do , formSubmit = FormNoSubmit } (infConflicts,infAccepted) <- case btnResult of - (FormSuccess ButtonInferStudyTerms) -> do - (infConflicts,infAmbiguous,infRedundant,infAccepted) <- Candidates.inferHandler - unless (null infAmbiguous) $ addMessageI Info $ MsgAmbiguousCandidatesRemoved $ length infAmbiguous - unless (null infRedundant) $ addMessageI Info $ MsgRedundantCandidatesRemoved $ length infRedundant - if null infAccepted - then addMessageI Info MsgNoCandidatesInferred - else addMessageI Success $ MsgCandidatesInferred $ length infAccepted - return (infConflicts,infAccepted) - _other -> (,[]) <$> runDB Candidates.conflicts - unless (null infConflicts) $ addMessage Warning "KONFLIKTE vorhanden" --TODO i18n + FormSuccess ButtonInferStudyTerms -> do + (infConflicts, infAmbiguous, infRedundant, infAccepted) <- Candidates.inferHandler + unless (null infAmbiguous) . addMessageI Info . MsgAmbiguousCandidatesRemoved $ length infAmbiguous + unless (null infRedundant) . addMessageI Info . MsgRedundantCandidatesRemoved $ length infRedundant + if + | null infAccepted + -> addMessageI Info MsgNoCandidatesInferred + | otherwise + -> addMessageI Success . MsgCandidatesInferred $ length infAccepted + return (infConflicts, infAccepted) + _other -> (, []) <$> runDB Candidates.conflicts ( (degreeResult,degreeTable) , (studyTermsResult,studytermsTable) - , ((),candidateTable)) <- runDB $ (,,) + , ((), candidateTable)) <- runDB $ (,,) <$> mkDegreeTable <*> mkStudytermsTable (Set.fromList $ map (StudyTermsKey' . fst) infAccepted) <*> mkCandidateTable + -- This needs to happen after calls to `dbTable` so they can short-circuit correctly + unless (null infConflicts) $ addMessageI Warning MsgStudyFeatureConflict + let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text)) degreeResult' = degreeResult <&> getDBFormResult (\row -> ( row ^. _dbrOutput . _entityVal . _studyDegreeName