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

StudyTermCandidates Deletion Buttons

Browse Source
This commit is contained in:
Steffen Jost 2019-03-29 15:24:16 +01:00
parent 7d2dd2efea
commit df0b36a01b
5 changed files with 64 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
messages/uniworx/de.msg
View File

@ -5,6 +5,9 @@ BtnRegister: Anmelden
BtnDeregister: Abmelden
BtnHijack: Sitzung übernehmen
BtnSave: Speichern
BtnCandidatesInfer: Studienfachzuordnung automatisch lernen
BtnCandidatesDeleteConflicts: Konflikte löschen
BtnCandidatesDeleteAll: Alle Beobachtungen löschen
Aborted: Abgebrochen
Remarks: Hinweise
@ -15,6 +18,11 @@ RegisterFrom: Anmeldungen von
RegisterTo: Anmeldungen bis
DeRegUntil: Abmeldungen bis
GenericKey: Schlüssel
GenericShort: Kürzel
GenericIsNew: Neu
GenericHasConflict: Konflikt
SummerTerm year@Integer: Sommersemester #{display year}
WinterTerm year@Integer: Wintersemester #{display year}/#{display $ succ year}
SummerTermShort year@Integer: SoSe #{display year}
@ -439,10 +447,10 @@ StudyFeatureType:
StudyFeatureValid: Aktiv
StudyFeatureUpdate: Abgeglichen
DegreeKey: Schlüssel Abschluss
DegreeKey: Abschlussschlüssel
DegreeName: Abschluss
DegreeShort: Abschlusskürzel
StudyTermsKey: Schlüssel Studiengang
StudyTermsKey: Studiengangschlüssel
StudyTermsName: Studiengang
StudyTermsShort: Studiengangkürzel
StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
@ -452,6 +460,8 @@ AmbiguousCandidatesRemoved n@Int: #{show n} #{pluralDE n "uneindeutiger Kandidat
RedundantCandidatesRemoved n@Int: #{show n} bereits #{pluralDE n "bekannter Kandidat" "bekannte Kandiaten"} entfernt
CandidatesInferred n@Int: #{show n} neue #{pluralDE n "Studiengangszuordnung" "Studiengangszuordnungen"} inferiert
NoCandidatesInferred: Keine neuen Studienganszuordnungen inferiert
AllIncidencesDeleted: Alle Beobachtungen wurden gelöscht.
IncidencesDeleted n@Int: #{show n} #{pluralDE n "Beobachtung" "Beobachtungen"} gelöscht
StudyTermIsNew: Neu
StudyFeatureConflict: Es wurden Konflikte in der Studiengang-Zuordnung gefunden

55
src/Handler/Admin.hs
View File

@ -204,7 +204,7 @@ postAdminTestR = do
buttonAction frag = Just . SomeRoute $ AdminTestR :#: frag
-- The actual call to @massInput@ is comparatively simple:
((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd buttonAction) "" True Nothing
@ -269,29 +269,34 @@ postAdminErrMsgR = do
-- BEGIN - Buttons needed only for StudyTermCandidateManagement
data ButtonInferStudyTerms = ButtonInferStudyTerms
data ButtonAdminStudyTerms
= BtnCandidatesInfer
| BtnCandidatesDeleteConflicts
| BtnCandidatesDeleteAll
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonInferStudyTerms
instance Finite ButtonInferStudyTerms
instance Universe ButtonAdminStudyTerms
instance Finite ButtonAdminStudyTerms
nullaryPathPiece ''ButtonInferStudyTerms camelToPathPiece
nullaryPathPiece ''ButtonAdminStudyTerms camelToPathPiece
embedRenderMessage ''UniWorX ''ButtonAdminStudyTerms id
instance Button UniWorX ButtonInferStudyTerms where
btnLabel ButtonInferStudyTerms = "Studienfachzuordnung automatisch lernen"
btnClasses ButtonInferStudyTerms = [BCIsButton, BCPrimary]
instance Button UniWorX ButtonAdminStudyTerms where
btnClasses BtnCandidatesInfer = [BCIsButton, BCPrimary]
btnClasses BtnCandidatesDeleteConflicts = [BCIsButton, BCDanger]
btnClasses BtnCandidatesDeleteAll = [BCIsButton, BCDanger]
-- END Button needed only here
getAdminFeaturesR, postAdminFeaturesR :: Handler Html
getAdminFeaturesR = postAdminFeaturesR
postAdminFeaturesR = do
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonInferStudyTerms)
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonAdminStudyTerms)
let btnForm = wrapForm btnWdgt def
{ formAction = Just $ SomeRoute AdminFeaturesR
, formEncoding = btnEnctype
, formSubmit = FormNoSubmit
}
(infConflicts,infAccepted) <- case btnResult of
FormSuccess ButtonInferStudyTerms -> do
FormSuccess BtnCandidatesInfer -> do
(infConflicts, infAmbiguous, infRedundant, infAccepted) <- Candidates.inferHandler
unless (null infAmbiguous) . addMessageI Info . MsgAmbiguousCandidatesRemoved $ length infAmbiguous
unless (null infRedundant) . addMessageI Info . MsgRedundantCandidatesRemoved $ length infRedundant
@ -301,6 +306,16 @@ postAdminFeaturesR = do
| otherwise
-> addMessageI Success . MsgCandidatesInferred $ length infAccepted
return (infConflicts, infAccepted)
FormSuccess BtnCandidatesDeleteConflicts -> runDB $ do
confs <- Candidates.conflicts
incis <- Candidates.getIncidencesFor (entityKey <$> confs)
deleteWhere [StudyTermCandidateIncidence <-. (E.unValue <$> incis)]
addMessageI Success $ MsgIncidencesDeleted $ length incis
return ([],[])
FormSuccess BtnCandidatesDeleteAll -> runDB $ do
deleteWhere ([] :: [Filter StudyTermCandidate])
addMessageI Success MsgAllIncidencesDeleted
(, []) <$> Candidates.conflicts
_other -> (, []) <$> runDB Candidates.conflicts
( (degreeResult,degreeTable)
@ -308,6 +323,7 @@ postAdminFeaturesR = do
, ((), candidateTable)) <- runDB $ (,,)
<$> mkDegreeTable
<*> mkStudytermsTable (Set.fromList $ map (StudyTermsKey' . fst) infAccepted)
(Set.fromList $ map entityKey infConflicts)
<*> mkCandidateTable
-- This needs to happen after calls to `dbTable` so they can short-circuit correctly
@ -352,7 +368,7 @@ postAdminFeaturesR = do
dbtRowKey = (E.^. StudyDegreeKey)
dbtProj = return
dbtColonnade = formColonnade $ mconcat
[ sortable (Just "key") (i18nCell MsgDegreeKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
[ sortable (Just "key") (i18nCell MsgGenericKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
, sortable (Just "name") (i18nCell MsgDegreeName) (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
, sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
, dbRow
@ -366,11 +382,12 @@ postAdminFeaturesR = do
dbtFilterUI = mempty
dbtParams = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)
}
psValidator = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
psValidator = def -- & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
& defaultSorting [SortAscBy "key"]
in dbTable psValidator DBTable{..}
mkStudytermsTable :: Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
mkStudytermsTable newKeys =
mkStudytermsTable :: Set (Key StudyTerms) -> Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
mkStudytermsTable newKeys badKeys =
let dbtIdent = "admin-studyterms" :: Text
dbtStyle = def
dbtSQLQuery :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
@ -378,15 +395,17 @@ postAdminFeaturesR = do
dbtRowKey = (E.^. StudyTermsKey)
dbtProj = return
dbtColonnade = formColonnade $ mconcat
[ sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
, sortable (Just "isnew") (i18nCell MsgStudyTermIsNew) (isNewCell . flip Set.member newKeys . view (_dbrOutput . _entityKey))
, sortable (Just "name") (i18nCell MsgStudyTermsName) (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
, sortable (Just "short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
[ sortable (Just "key") (i18nCell MsgGenericKey) (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
, sortable (Just "isnew") (i18nCell MsgGenericIsNew) (isNewCell . flip Set.member newKeys . view (_dbrOutput . _entityKey))
, sortable (Just "isbad") (i18nCell MsgGenericHasConflict) (isBadCell . flip Set.member badKeys . view (_dbrOutput . _entityKey))
, sortable (Just "name") (i18nCell MsgStudyTermsName) (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
, sortable (Just "short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
, dbRow
]
dbtSorting = Map.fromList
[ ("key" , SortColumn (E.^. StudyTermsKey))
, ("isnew" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsId `E.in_` E.valList (Set.toList newKeys)))
, ("isbad" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsId `E.in_` E.valList (Set.toList badKeys)))
, ("name" , SortColumn (E.^. StudyTermsName))
, ("short" , SortColumn (E.^. StudyTermsShorthand))
]

4
src/Handler/Utils/Table/Cells.hs
View File

@ -57,6 +57,10 @@ sqlCell act = mempty & cellContents .~ lift act
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
tickmarkCell = cell . toWidget . hasTickmark
-- | Maybe display an icon for tainted rows
isBadCell :: (IsDBTable m a) => Bool -> DBCell m a
isBadCell = cell . toWidget . isBad
-- | Maybe display a exclamation icon
isNewCell :: (IsDBTable m a) => Bool -> DBCell m a
isNewCell = cell . toWidget . isNew

7
src/Handler/Utils/TermCandidates.hs
View File

@ -180,5 +180,8 @@ conflicts = E.select $ E.from $ \studyTerms -> do
E.where_ $ studyTerms E.^. StudyTermsName E.==. E.just (candidateTwo E.^. StudyTermCandidateName)
return studyTerms
-- | retrieve all incidence keys having containing a certain @StudyTermKey @
getIncidencesFor :: [Key StudyTerms] -> DB [E.Value TermCandidateIncidence]
getIncidencesFor stks = E.select $ E.distinct $ E.from $ \candidate -> do
E.where_ $ candidate E.^. StudyTermCandidateKey `E.in_` E.valList (unStudyTermsKey <$> stks)
return $ candidate E.^. StudyTermCandidateIncidence

7
src/Utils.hs
View File

@ -140,8 +140,13 @@ hasTickmark :: Bool -> Markup
hasTickmark True = [shamlet|<i .fas .fa-check>|]
hasTickmark False = mempty
isBad :: Bool -> Markup
-- ^ Display an icon that denotes that something™ is bad
isBad True = [shamlet|<i .fas .fa-bolt>|] -- or times?!
isBad False = mempty
isNew :: Bool -> Markup
isNew True = [shamlet|<i .fas .fa-exclamation>|]
isNew True = [shamlet|<i .fas .fa-seedling>|] -- was exclamation
isNew False = mempty