Conflict detection for studyTermCandidates implemented
This commit is contained in:
parent
5a8fa8648f
commit
86086633ab
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user