Inferenz Studiengänge verdrahte, hat noch Fehler
This commit is contained in:
Steffen Jost
parent
8c221ad5e8
commit
d65b5918f0
@ -346,7 +346,6 @@ NoTableContent: Kein Tabelleninhalt
|
||||
NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
|
||||
|
||||
AdminHeading: Administration
|
||||
AdminFeaturesHeading: Studiengänge
|
||||
AdminUserHeading: Benutzeradministration
|
||||
AccessRightsFor: Berechtigungen für
|
||||
AdminFor: Administrator
|
||||
@ -408,6 +407,8 @@ SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2work-externes Verfahr
|
||||
|
||||
SubmissionNoUploadExpected: Es ist keine Abgabe von Dateien vorgesehen.
|
||||
|
||||
AdminFeaturesHeading: Studiengänge
|
||||
StudyFeatureInference: Studiengangschlüssel-Inferenz
|
||||
StudyFeatureAge: Fachsemester
|
||||
StudyFeatureDegree: Abschluss
|
||||
FieldPrimary: Hauptfach
|
||||
@ -423,6 +424,11 @@ StudyTermsShort: Studiengangkürzel
|
||||
StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
|
||||
StudyDegreeChangeSuccess: Zuordnung Studiengänge aktualisiert
|
||||
StudyCandidateIncidence: Anmeldevorgang
|
||||
AmbiguousCandidatesRemoved n@Int: #{show n} #{pluralDE n "uneindeutiger Kandidat" "uneindeutige Kandiaten"} entfernt
|
||||
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
|
||||
StudyTermIsNew: Neu
|
||||
|
||||
MailTestFormEmail: Email-Addresse
|
||||
MailTestFormLanguages: Spracheinstellungen
|
||||
|
||||
@ -49,17 +49,20 @@ StudyDegree -- Studienabschluss
|
||||
shorthand Text Maybe -- admin determined shorthand
|
||||
name Text Maybe -- description given by LDAP
|
||||
Primary key -- column key is used as actual DB row key
|
||||
-- newtype Key StudyDegree = StudyDegreeKey' { unStudyDegreeKey :: Int }
|
||||
deriving Show
|
||||
StudyTerms -- Studiengang
|
||||
key Int -- LMU-internal key
|
||||
shorthand Text Maybe -- admin determined shorthand
|
||||
name Text Maybe -- description given by LDAP
|
||||
Primary key -- column key is used as actual DB row key
|
||||
-- newtype Key StudyTerms = StudyTermsKey { unStudyTermsKey :: Int }
|
||||
-- newtype Key StudyTerms = StudyTermsKey' { unStudyTermsKey :: Int }
|
||||
deriving Show
|
||||
StudyTermCandidate -- No one at LMU is willing and able to tell us the meaning of the keys for StudyDegrees and StudyTerms.
|
||||
-- Each LDAP login provides an unordered set of keys and an unordered set of plain text description with an unknown 1-1 correspondence.
|
||||
-- This table helps us to infer which key belongs to which plain text by recording possible combinations at login.
|
||||
-- If a login provides n keys and n plan texts, then n^2 rows with the same incidence are created, storing all combinations
|
||||
incidence UUID -- random id, generated once per login to associate matching pairs
|
||||
incidence TermCandidateIncidence -- random id, generated once per login to associate matching pairs
|
||||
key Int -- a possible key for the studyTermName
|
||||
name Text -- studyTermName as plain text from LDAP
|
||||
deriving Show Eq Ord
|
||||
|
||||
@ -2097,11 +2097,11 @@ instance YesodAuth UniWorX where
|
||||
fs <- either (\err -> throwError . ServerError $ "Could not parse features of study: " <> err) return userStudyFeatures
|
||||
|
||||
let
|
||||
studyTermCandidates = Set.fromList $ do
|
||||
studyTermCandidates = do
|
||||
studyTermCandidateName <- termNames
|
||||
StudyFeatures{ studyFeaturesField = StudyTermsKey' studyTermCandidateKey } <- fs
|
||||
return StudyTermCandidate{..}
|
||||
lift . insertMany_ $ Set.toList studyTermCandidates
|
||||
lift $ insertMany_ studyTermCandidates
|
||||
|
||||
lift $ E.updateWhere [StudyFeaturesUser ==. userId] [StudyFeaturesValid =. False]
|
||||
forM_ fs $ \f@StudyFeatures{..} -> do
|
||||
|
||||
@ -15,7 +15,7 @@ import Utils.Lens
|
||||
-- import Data.Function ((&))
|
||||
-- import Yesod.Form.Bootstrap3
|
||||
|
||||
-- import qualified Data.Set as Set
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Database.Persist.Sql (fromSqlKey)
|
||||
@ -56,7 +56,7 @@ instance Button UniWorX ButtonCreate where
|
||||
|
||||
btnClasses CreateMath = [BCIsButton, BCInfo]
|
||||
btnClasses CreateInf = [BCIsButton, BCPrimary]
|
||||
-- END Button needed here
|
||||
-- END Button needed only here
|
||||
|
||||
emailTestForm :: AForm (HandlerT UniWorX IO) (Email, MailContext)
|
||||
emailTestForm = (,)
|
||||
@ -176,17 +176,40 @@ postAdminErrMsgR = do
|
||||
|]
|
||||
|
||||
|
||||
-- BEGIN - Buttons needed only for StudyTermCandidateManagement
|
||||
data ButtonInferStudyTerms = ButtonInferStudyTerms
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonInferStudyTerms
|
||||
instance Finite ButtonInferStudyTerms
|
||||
|
||||
nullaryPathPiece ''ButtonInferStudyTerms camelToPathPiece
|
||||
|
||||
instance Button UniWorX ButtonInferStudyTerms where
|
||||
btnLabel ButtonInferStudyTerms = "Studienfachzuordnung automatisch lernen"
|
||||
btnClasses ButtonInferStudyTerms = [BCIsButton, BCPrimary]
|
||||
-- END Button needed only here
|
||||
|
||||
getAdminFeaturesR, postAdminFeaturesR :: Handler Html
|
||||
getAdminFeaturesR = postAdminFeaturesR
|
||||
postAdminFeaturesR = do
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonInferStudyTerms)
|
||||
(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
|
||||
|
||||
( (degreeResult,degreeTable)
|
||||
, (studyTermsResult,studytermsTable)
|
||||
, conflicted
|
||||
, ((),candidateTable)) <- runDB $ (,,,)
|
||||
, ((),candidateTable)) <- runDB $ (,,)
|
||||
<$> mkDegreeTable
|
||||
<*> mkStudytermsTable
|
||||
<*> Candidates.conflicts
|
||||
<*> mkStudytermsTable (Set.fromList $ map (StudyTermsKey' . fst) infAccepted)
|
||||
<*> mkCandidateTable
|
||||
|
||||
let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text))
|
||||
@ -211,25 +234,7 @@ postAdminFeaturesR = do
|
||||
|
||||
siteLayoutMsg MsgAdminFeaturesHeading $ do
|
||||
setTitleI MsgAdminFeaturesHeading
|
||||
[whamlet|
|
||||
<div .container>
|
||||
<section>
|
||||
^{degreeTable}
|
||||
<div .container>
|
||||
<section>
|
||||
^{studytermsTable}
|
||||
<div .container>
|
||||
<section>
|
||||
$if null conflicted
|
||||
Kein Konflikte beobachtet.
|
||||
$else
|
||||
<h3>Studiengangseingträge mit beobachteten Konflikten:
|
||||
<ul>
|
||||
$forall (Entity _ (StudyTerms ky _ nm)) <- conflicted
|
||||
<li> #{show ky} - #{foldMap id nm}
|
||||
<div .container>
|
||||
^{candidateTable}
|
||||
|]
|
||||
$(widgetFile "adminFeatures")
|
||||
where
|
||||
textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))
|
||||
(\row _mkUnique -> (\(res,fieldView) -> (set lensRes <$> res, fvInput fieldView))
|
||||
@ -246,23 +251,24 @@ postAdminFeaturesR = do
|
||||
dbtRowKey = (E.^. StudyDegreeKey)
|
||||
dbtProj = return
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ sortable (Just "degree-key") (i18nCell MsgDegreeKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
|
||||
, sortable (Just "degree-name") (i18nCell MsgDegreeName) (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
|
||||
, sortable (Just "degree-short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
|
||||
[ sortable (Just "key") (i18nCell MsgDegreeKey) (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
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("degree-key" , SortColumn (E.^. StudyDegreeKey))
|
||||
, ("degree-name" , SortColumn (E.^. StudyDegreeName))
|
||||
, ("degree-short", SortColumn (E.^. StudyDegreeShorthand))
|
||||
[ ("key" , SortColumn (E.^. StudyDegreeKey))
|
||||
, ("name" , SortColumn (E.^. StudyDegreeName))
|
||||
, ("short", SortColumn (E.^. StudyDegreeShorthand))
|
||||
]
|
||||
dbtFilter = mempty
|
||||
dbtFilterUI = mempty
|
||||
dbtParams = def { dbParamsFormAddSubmit = True } -- dbParamsFormEvaluate = liftHandlerT . (runFormPost . identifyForm "degree-table" - (identForm FIDdegree))}
|
||||
psValidator = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"]
|
||||
psValidator = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
|
||||
in dbTable psValidator DBTable{..}
|
||||
|
||||
mkStudytermsTable :: DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
|
||||
mkStudytermsTable =
|
||||
mkStudytermsTable :: Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
|
||||
mkStudytermsTable newKeys =
|
||||
let dbtIdent = "admin-studyterms" :: Text
|
||||
dbtStyle = def
|
||||
dbtSQLQuery :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
|
||||
@ -270,19 +276,22 @@ postAdminFeaturesR = do
|
||||
dbtRowKey = (E.^. StudyTermsKey)
|
||||
dbtProj = return
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ sortable (Just "studyterms-key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
|
||||
, sortable (Just "studyterms-name") (i18nCell MsgStudyTermsName) (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
|
||||
, sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
|
||||
[ 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))
|
||||
, dbRow
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("studyterms-key" , SortColumn (E.^. StudyTermsKey))
|
||||
, ("studyterms-name" , SortColumn (E.^. StudyTermsName))
|
||||
, ("studyterms-short", SortColumn (E.^. StudyTermsShorthand))
|
||||
[ ("key" , SortColumn (E.^. StudyTermsKey))
|
||||
, ("isnew" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsId `E.in_` E.valList (Set.toList newKeys)))
|
||||
, ("name" , SortColumn (E.^. StudyTermsName))
|
||||
, ("short" , SortColumn (E.^. StudyTermsShorthand))
|
||||
]
|
||||
dbtFilter = mempty
|
||||
dbtFilterUI = mempty
|
||||
dbtParams = def { dbParamsFormAddSubmit = True } -- , dbParamsFormEvaluate = liftHandlerT . runFormPost }
|
||||
psValidator = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
|
||||
psValidator = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
|
||||
in dbTable psValidator DBTable{..}
|
||||
|
||||
mkCandidateTable =
|
||||
@ -293,14 +302,15 @@ postAdminFeaturesR = do
|
||||
dbtRowKey = (E.^. StudyTermCandidateId)
|
||||
dbtProj = return
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ sortable (Just "termcandidate-key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
|
||||
, sortable (Just "termcandidate-name") (i18nCell MsgStudyTermsName) (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
|
||||
, sortable (Just "termcandidate-incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
|
||||
[ dbRow
|
||||
, sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
|
||||
, sortable (Just "name") (i18nCell MsgStudyTermsName) (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
|
||||
, sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("termcandidate-key" , SortColumn (E.^. StudyTermCandidateKey))
|
||||
, ("termcandidate-name" , SortColumn (E.^. StudyTermCandidateName))
|
||||
, ("termcandidate-incidence", SortColumn (E.^. StudyTermCandidateIncidence))
|
||||
[ ("key" , SortColumn (E.^. StudyTermCandidateKey))
|
||||
, ("name" , SortColumn (E.^. StudyTermCandidateName))
|
||||
, ("incidence", SortColumn (E.^. StudyTermCandidateIncidence))
|
||||
]
|
||||
dbtFilter = Map.fromList
|
||||
[ ("key", FilterColumn $ mkExactFilter (E.^. StudyTermCandidateKey))
|
||||
@ -314,6 +324,6 @@ postAdminFeaturesR = do
|
||||
, prismAForm (singletonFilter "incidence") mPrev $ aopt (searchField False) (fslI MsgStudyCandidateIncidence)
|
||||
]
|
||||
dbtParams = def
|
||||
psValidator = def & defaultSorting [SortAscBy "termcandidate-key", SortAscBy "termcandidate-name"]
|
||||
psValidator = def & defaultSorting [SortAscBy "key", SortAscBy "name"]
|
||||
in dbTable psValidator DBTable{..}
|
||||
|
||||
|
||||
@ -57,6 +57,10 @@ sqlCell act = mempty & cellContents .~ lift act
|
||||
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
|
||||
tickmarkCell = cell . toWidget . hasTickmark
|
||||
|
||||
-- | Maybe display a exclamation icon
|
||||
isNewCell :: (IsDBTable m a) => Bool -> DBCell m a
|
||||
isNewCell = cell . toWidget . isNew
|
||||
|
||||
-- | Maybe display comment icon linking a given URL or show nothing at all
|
||||
commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
|
||||
commentCell Nothing = mempty
|
||||
|
||||
@ -28,13 +28,10 @@ import qualified Database.Esqueleto as E
|
||||
-- import Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
type STKey = Int -- Key StudyTerms -- for convenience, assmued identical to field StudyTermCandidateKey
|
||||
type STKey = Int -- for convenience, assmued identical to field StudyTermCandidateKey
|
||||
|
||||
data FailedCandidateInference = FailedCandidateInference [Entity StudyTerms]
|
||||
deriving (Typeable)
|
||||
|
||||
instance Show FailedCandidateInference where
|
||||
show (FailedCandidateInference _) = "Failed Candidate Inference" -- TODO
|
||||
deriving (Typeable, Show)
|
||||
|
||||
instance Exception FailedCandidateInference
|
||||
-- Default Instance
|
||||
@ -43,54 +40,30 @@ instance Exception FailedCandidateInference
|
||||
shortenStudyTerm :: Text -> Text
|
||||
shortenStudyTerm = concatMap (take 4) . splitCamel
|
||||
|
||||
-- | Attempt to identify new StudyTerms based on observations
|
||||
inferHandler :: Handler ([UUID],([Entity StudyTerms],[Entity StudyTermCandidate],[(STKey,Text)]))
|
||||
inferHandler = do
|
||||
(ambiguous, problems) <- runDB $ (,) <$> removeAmbiguous <*> conflicts
|
||||
if (null problems)
|
||||
then do
|
||||
infRes <- inferAcc ([],[])
|
||||
return (ambiguous, infRes)
|
||||
else
|
||||
return (ambiguous,(problems,[],[]))
|
||||
|
||||
-- | Attempt to identify new StudyTerms based on observations, returning:
|
||||
-- * list of ambiguous instances that were discarded outright (identical names for differents keys observed in single incidences)
|
||||
-- * list of problems, ie. StudyTerms that contradict observed incidences
|
||||
-- * list of redundants, i.e. redundant observed incidences
|
||||
-- * list of accepted, i.e. newly accepted key/name pairs
|
||||
inferHandler :: Handler ([Entity StudyTerms],[TermCandidateIncidence],[Entity StudyTermCandidate],[(STKey,Text)])
|
||||
inferHandler = runDB $ inferAcc ([],[],[])
|
||||
where
|
||||
inferAcc (accRedundants, accAccepted) =
|
||||
handle (\(FailedCandidateInference fails) -> return (fails,accRedundants,accAccepted)) $ do
|
||||
(infReds,infAccs) <- runDB inferStep
|
||||
inferAcc (accAmbiguous, accRedundants, accAccepted) =
|
||||
handle (\(FailedCandidateInference fails) -> (fails,accAmbiguous,accRedundants,accAccepted) <$ E.transactionUndo) $ do
|
||||
(infAmbis, infReds,infAccs) <- inferStep
|
||||
if null infAccs
|
||||
then return ([], infReds ++ accRedundants, accAccepted)
|
||||
else inferAcc (infReds ++ accRedundants, infAccs ++ accAccepted)
|
||||
then return ([], accAmbiguous, infReds ++ accRedundants, accAccepted)
|
||||
else do
|
||||
E.transactionSave -- commit transaction if there are no problems
|
||||
inferAcc (infAmbis ++ accAmbiguous, infReds ++ accRedundants, infAccs ++ accAccepted)
|
||||
|
||||
inferStep = do
|
||||
ambiguous <- removeAmbiguous
|
||||
redundants <- removeRedundant
|
||||
accepted <- acceptSingletons
|
||||
problems <- conflicts
|
||||
when (not $ null problems) $ throw $ FailedCandidateInference problems
|
||||
return (redundants, accepted)
|
||||
|
||||
|
||||
-- | Attempt to identify new StudyTerms based on observations
|
||||
-- infer :: MonadHandler m => m ([Entity StudyTerms],[Entity StudyTerms])
|
||||
infer :: DB ([Entity StudyTerms],[(STKey, Text)])
|
||||
infer = do
|
||||
void removeAmbiguous -- TODO: show result
|
||||
inferAcc []
|
||||
where
|
||||
inferAcc prevSet = do
|
||||
problems <- conflicts
|
||||
if null problems
|
||||
then do
|
||||
void removeRedundant -- TODO: show result
|
||||
newSet <- acceptSingletons
|
||||
if null newSet
|
||||
then -- inference complete
|
||||
return ([],prevSet)
|
||||
else
|
||||
inferAcc (newSet ++ prevSet)
|
||||
else --abort
|
||||
return (problems,prevSet)
|
||||
|
||||
when (not $ null problems) $ throwM $ FailedCandidateInference problems
|
||||
return (ambiguous, redundants, accepted)
|
||||
|
||||
{-
|
||||
Candidate 1 11 "A"
|
||||
@ -113,7 +86,7 @@ as a fix we simply eliminate all observations that have the same name twice, see
|
||||
-- | remove candidates with ambiguous observations,
|
||||
-- ie. candidates that have duplicated term names with differing keys
|
||||
-- which may happen in rare cases
|
||||
removeAmbiguous :: DB [UUID]
|
||||
removeAmbiguous :: DB [TermCandidateIncidence]
|
||||
removeAmbiguous = do
|
||||
ambiList <- E.select $ E.from $ \(candA `E.InnerJoin` candB) -> do
|
||||
-- Either an innerJoin with itself or an exists-sub-select
|
||||
@ -165,7 +138,7 @@ acceptSingletons = do
|
||||
groupedCandidates = foldl' groupFun mempty incidences
|
||||
|
||||
-- given a key, map each incidence to set of possible names for this key
|
||||
groupFun :: Map STKey (Map UUID (Set Text)) -> StudyTermCandidate -> Map STKey (Map UUID (Set Text))
|
||||
groupFun :: Map STKey (Map TermCandidateIncidence (Set Text)) -> StudyTermCandidate -> Map STKey (Map TermCandidateIncidence (Set Text))
|
||||
groupFun m StudyTermCandidate{..} =
|
||||
insertWith (Map.unionWith Set.union)
|
||||
studyTermCandidateKey
|
||||
@ -192,37 +165,11 @@ acceptSingletons = do
|
||||
-- insertKey (StudyTermsKey key) $ StudyTerms key (Just $ shortenStudyTerm name) (Just name) -- name clash!
|
||||
void . insert $ StudyTerms key (Just $ shortenStudyTerm name) (Just name)
|
||||
|
||||
|
||||
-- register newly fixed candidates
|
||||
forM_ fixedKeys registerFixed
|
||||
return fixedKeys
|
||||
|
||||
|
||||
-- SOME EARLIER ATTEMPTS FOLLOW:
|
||||
--
|
||||
-- unknownKeys <- E.select $ E.distinct $ E.from $ \candidate -> do
|
||||
-- E.where_ $ E.notExists $ E.from $ \sterm ->
|
||||
-- E.where_ $ candidate E.^. StudyTermCandidateKey E.==. sterm E.^. StudyTermKey
|
||||
-- return $ candidate E.^. StudyTermCandidateKey
|
||||
-- forM unknownKeys $ \(E.Value key) -> do
|
||||
-- incidences <- E.select $ E.from $ \candidate -> do
|
||||
-- E.where_ $
|
||||
--
|
||||
-- -- DON'T KNOW HOW TO DO IN SQL :( BUT WE NEED THE ENTIRE TABLE ANYHOW
|
||||
-- candidates <- entityVal <$> selectList [] [] -- load entire candidate table
|
||||
-- -- create map from UUID to set of candidates for efficiency
|
||||
-- let collectCandidates m stc@StudyTermCandidate{studyTermCandidateIncidence=inci}
|
||||
-- = insertWith Set.union inci stc
|
||||
-- incidences = foldl collectCandidates Map.empty candidates
|
||||
--
|
||||
-- collectKeys m
|
||||
-- keySets = foldl collectKeys Map.empty candidates
|
||||
--
|
||||
-- -- StudyTermCandidateKey -> Set StudyTermCandidateName
|
||||
|
||||
|
||||
|
||||
|
||||
-- | all existing StudyTerms that are contradiced by current observations
|
||||
conflicts :: DB [Entity StudyTerms]
|
||||
conflicts = E.select $ E.from $ \studyTerms -> do
|
||||
|
||||
@ -785,3 +785,4 @@ type UserEmail = CI Email
|
||||
|
||||
type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString
|
||||
type InstanceId = UUID
|
||||
type TermCandidateIncidence = UUID
|
||||
|
||||
@ -161,6 +161,11 @@ hasTickmark :: Bool -> Markup
|
||||
hasTickmark True = [shamlet|<i .fas .fa-check>|]
|
||||
hasTickmark False = mempty
|
||||
|
||||
isNew :: Bool -> Markup
|
||||
isNew True = [shamlet|<i .fas .fa-exclamation>|]
|
||||
isNew False = mempty
|
||||
|
||||
|
||||
---------------------
|
||||
-- Text and String --
|
||||
---------------------
|
||||
|
||||
19
templates/adminFeatures.hamlet
Normal file
19
templates/adminFeatures.hamlet
Normal file
@ -0,0 +1,19 @@
|
||||
<section>
|
||||
^{degreeTable}
|
||||
<section>
|
||||
^{studytermsTable}
|
||||
<section>
|
||||
<h2>_{MsgStudyFeatureInference}
|
||||
<p>
|
||||
$if null infConflicts
|
||||
Kein Konflikte beobachtet.
|
||||
$else
|
||||
<h3>Studiengangseingträge mit beobachteten Konflikten:
|
||||
<ul>
|
||||
$forall (Entity _ (StudyTerms ky _ nm)) <- infConflicts
|
||||
<li> #{show ky} - #{foldMap id nm}
|
||||
<form .form-inline method=post action=@{AdminFeaturesR} enctype=#{btnEnctype}>
|
||||
^{btnWdgt}
|
||||
|
||||
<div .container>
|
||||
^{candidateTable}
|
||||
Loading…
Reference in New Issue
Block a user