Conflict detection for studyTermCandidates implemented

This commit is contained in:
SJost 2019-03-13 21:17:30 +01:00
parent 5a8fa8648f
commit 86086633ab
2 changed files with 26 additions and 4 deletions

View File

@ -178,9 +178,11 @@ getAdminFeaturesR = postAdminFeaturesR
postAdminFeaturesR = do
( (degreeResult,degreeTable)
, (studyTermsResult,studytermsTable)
, ((),candidateTable)) <- runDB $ (,,)
, conflicts
, ((),candidateTable)) <- runDB $ (,,,)
<$> mkDegreeTable
<*> mkStudytermsTable
<*> conflictedStudyTerms
<*> mkCandidateTable
let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text))
@ -214,6 +216,14 @@ postAdminFeaturesR = do
^{studytermsTable}
<div .container>
<section>
$if null conflicts
Kein Konflikte beobachtet.
$else
<h3>Studiengangseingträge mit beobachteten Konflikten:
<ul>
$forall (Entity _ (StudyTerms ky _ nm)) <- conflicts
<li> #{show ky} - #{foldMap id nm}
^{candidateTable}
|]
where
@ -291,5 +301,15 @@ postAdminFeaturesR = do
dbtFilter = mempty
dbtFilterUI = mempty
dbtParams = def
psValidator = def & defaultSorting [SortAscBy "termcandidate-name", SortAscBy "termcandidate-key"]
in dbTable psValidator DBTable{..}
psValidator = def & defaultSorting [SortAscBy "termcandidate-key", SortAscBy "termcandidate-name"]
in dbTable psValidator DBTable{..}
conflictedStudyTerms :: DB [Entity StudyTerms]
conflictedStudyTerms = E.select $ E.from $ \studyTerms -> do
E.where_ $ E.not_ $ E.isNothing $ studyTerms E.^. StudyTermsName
E.where_ $ E.exists $ E.from $ \candidateOne -> do
E.where_ $ candidateOne E.^. StudyTermCandidateKey E.==. studyTerms E.^. StudyTermsKey
E.where_ $ E.notExists . E.from $ \candidateTwo -> do
E.where_ $ candidateTwo E.^. StudyTermCandidateIncidence E.==. candidateOne E.^. StudyTermCandidateIncidence
E.where_ $ studyTerms E.^. StudyTermsName E.==. E.just (candidateTwo E.^. StudyTermCandidateName)
return studyTerms

View File

@ -231,7 +231,7 @@ fillDb = do
sdBiol = StudyTermsKey' 26
sdChem1 = StudyTermsKey' 61
sdChem2 = StudyTermsKey' 113
repsert sdInf $ StudyTerms 79 (Just "Inf") (Just "Informatik")
repsert sdInf $ StudyTerms 79 (Just "Inf") (Just "Informatikk")
repsert sdMath $ StudyTerms 105 (Just "Math" ) (Just "Mathematik")
repsert sdMedi $ StudyTerms 121 Nothing (Just "Fehler hier")
repsert sdPhys $ StudyTerms 128 Nothing Nothing -- intentionally left unknown
@ -283,6 +283,8 @@ fillDb = do
void . insert $ StudyTermCandidate incidence8 128 "Medieninformatik"
void . insert $ StudyTermCandidate incidence8 121 "Physik"
void . insert $ StudyTermCandidate incidence8 121 "Medieninformatik"
incidence9 <- liftIO getRandom
void . insert $ StudyTermCandidate incidence9 79 "Informatik"
sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
maxMuster