chore(log): add more filter options to admin problem log
This commit is contained in:
parent
073432c75b
commit
feb8d92bc1
@ -126,6 +126,7 @@ AdminProblemSolved: Erledigt
|
||||
AdminProblemSolver: Bearbeitet von
|
||||
AdminProblemCreated: Erkannt
|
||||
AdminProblemInfo: Problembeschreibung
|
||||
AdminProblemInfoTooltip: Nur Teile der folgenden englische Begriffe sind derzeit möglich: new-company, supervisor-new-company, supervisor-left-company, superior-change, newly-unsupervised und unknown
|
||||
AdminProblemsSolved n@Int: #{pluralDEeN n "Admin Problem"} als erledigt markiert
|
||||
AdminProblemsReopened n@Int: #{pluralDEeN n "Admin Problem"} erneut eröffnet
|
||||
AdminProblemNewCompany: Neue Firma über AVS automatisch erstellt; prüfen und ggf. Standardansprechpartner eintragen
|
||||
|
||||
@ -126,6 +126,7 @@ AdminProblemSolved: Done
|
||||
AdminProblemSolver: Solved by
|
||||
AdminProblemCreated: Recognized
|
||||
AdminProblemInfo: Problem
|
||||
AdminProblemInfoTooltip: Only parts of the following keys currently work here: new-company, supervisor-new-company, supervisor-left-company, superior-change, newly-unsupervised und unknown
|
||||
AdminProblemsSolved n: #{pluralENsN n "admin problem"} marked as solved
|
||||
AdminProblemsReopened n: #{pluralENsN n "admin problem"} reopened
|
||||
AdminProblemNewCompany: New company from AVS; verify and add default supervisors
|
||||
|
||||
@ -261,6 +261,7 @@ derivePersistFieldJSON ''Transaction
|
||||
-- Datatype for raising admin awareness to certain problems
|
||||
-- Database stores generic Value in table ProblemLog, such that changes do not disturb old entries
|
||||
-- Note that there is no RenderMessage instance, instead see @Handler.Admin.adminProblemCell dealing with special cases instead
|
||||
-- Note: Adjust MsgAdminProblemInfoTooltip as well
|
||||
data AdminProblem
|
||||
= AdminProblemNewCompany -- new company was noticed, presumably without supervisors
|
||||
{ adminProblemCompany :: CompanyId
|
||||
|
||||
@ -339,10 +339,18 @@ mkProblemLogTable = over _1 postprocess <$> dbTable validator DBTable{..}
|
||||
, single ("solver", sortUserNameBareM querySolver)
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single ("solved" , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved)))
|
||||
[ single ("user" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryUser) (E.?. UserDisplayName))
|
||||
, single ("solver" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to querySolver) (E.?. UserDisplayName))
|
||||
, single ("problem" , FilterColumn . E.mkContainsFilter $ views (to queryProblem) ((E.->>. "problem").(E.^. ProblemLogInfo)))
|
||||
, single ("company" , FilterColumn . E.mkContainsFilter $ views (to queryProblem) ((E.->>. "company").(E.^. ProblemLogInfo)))
|
||||
, single ("solved" , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved)))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ prismAForm (singletonFilter "solved" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved)
|
||||
[ prismAForm (singletonFilter "user" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemUser & setTooltip MsgTableFilterCommaPlus)
|
||||
, prismAForm (singletonFilter "solver" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemSolver & setTooltip MsgTableFilterCommaPlusShort)
|
||||
, prismAForm (singletonFilter "problem" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemInfo & setTooltip MsgAdminProblemInfoTooltip)
|
||||
, prismAForm (singletonFilter "company" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableCompanyShort)
|
||||
, prismAForm (singletonFilter "solved" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved)
|
||||
]
|
||||
acts :: Map ProblemTableAction (AForm Handler ProblemTableActionData)
|
||||
acts = mconcat
|
||||
|
||||
@ -417,12 +417,16 @@ fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map F
|
||||
fltrUserNameUI = fltrUserNameLinkUI
|
||||
|
||||
fltrUserNameLinkUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrUserNameLinkUI = fltrUserNameLinkHdrUI MsgTableCourseMembers
|
||||
fltrUserNameLinkUI = fltrUserNameLinkHdrUI MsgTableCourseMembers
|
||||
|
||||
fltrUserNameLinkHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrUserNameLinkHdrUI msg mPrev =
|
||||
fltrUserNameLinkHdrUI msg mPrev =
|
||||
prismAForm (singletonFilter "user-name") mPrev $ aopt textField (fslI msg)
|
||||
|
||||
fltrUserDisplayNameHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrUserDisplayNameHdrUI msg mPrev =
|
||||
prismAForm (singletonFilter "user-display-name") mPrev $ aopt textField (fslI msg)
|
||||
|
||||
fltrUserNameEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrUserNameEmailUI = fltrUserNameEmailHdrUI MsgTableCourseMembers
|
||||
|
||||
@ -686,7 +690,7 @@ fltrRelevantStudyFeaturesTerms queryTermUser = singletonMap "features-terms" . F
|
||||
|
||||
fltrRelevantStudyFeaturesTermsUI :: DBFilterUI
|
||||
fltrRelevantStudyFeaturesTermsUI = fltrStudyTermsUI
|
||||
|
||||
|
||||
fltrRelevantStudyFeaturesDegree :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
|
||||
fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" . FilterColumn $ \t criterias ->
|
||||
E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
|
||||
@ -705,7 +709,7 @@ fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" .
|
||||
fltrRelevantStudyFeaturesDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrRelevantStudyFeaturesDegreeUI mPrev =
|
||||
prismAForm (singletonFilter "features-degree") mPrev $ aopt textField (fslI MsgTableDegreeName)
|
||||
|
||||
|
||||
fltrRelevantStudyFeaturesSemester :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
|
||||
fltrRelevantStudyFeaturesSemester queryTermUser = singletonMap "features-semester" . FilterColumn $ \t criterias ->
|
||||
E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
|
||||
@ -741,13 +745,13 @@ fltrQualificationHdrUI msg mPrev = prismAForm (singletonFilter "qualification" .
|
||||
|
||||
{-
|
||||
-- colUserCompany :: (HandlerSite (DBCell m) ~ UniWorX, IsDBTable m c, HasEntity a User) => Colonnade Sortable a (DBCell m c)
|
||||
colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> do
|
||||
colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> do
|
||||
let uid = heu ^. hasEntity . _entityKey
|
||||
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||
let companies = intersperse (text2markup ", ") $
|
||||
let companies = intersperse (text2markup ", ") $
|
||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
icnSuper = text2markup " " <> icon IconSupervisor
|
||||
cell $ toWgt $ mconcat companies
|
||||
@ -756,13 +760,13 @@ colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \
|
||||
-- PROBLEM: how to type sqlCell compatible with dbTable that as actions, i.e. MForm instead of YesodDB?
|
||||
colUserCompany :: (IsDBTable (YesodDB UniWorX) c, HasEntity a User) => Colonnade Sortable a (DBCell (YesodDB UniWorX) c)
|
||||
colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu ->
|
||||
let uid = heu ^. hasEntity . _entityKey in
|
||||
sqlCell $ do
|
||||
let uid = heu ^. hasEntity . _entityKey in
|
||||
sqlCell $ do
|
||||
companies' <- E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||
let companies = intersperse (text2markup ", ") $
|
||||
let companies = intersperse (text2markup ", ") $
|
||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
icnSuper = text2markup " " <> icon IconSupervisor
|
||||
pure $ toWgt $ mconcat companies
|
||||
@ -803,12 +807,12 @@ fltrCompanyNameNr query = ("company-name-number", FilterColumn $ \needle (setFol
|
||||
let numCrits = setMapMaybe readMay criterias
|
||||
fltrCName = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyName)) needle criterias
|
||||
fltrCShort = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyShorthand)) needle criterias
|
||||
fltrCno = mkExactFilter (query >>> (E.^. CompanyAvsId)) needle numCrits
|
||||
fltrCno = mkExactFilter (query >>> (E.^. CompanyAvsId)) needle numCrits
|
||||
in if null numCrits
|
||||
then fltrCName E.||. fltrCShort
|
||||
else fltrCName E.||. fltrCShort E.||. fltrCno
|
||||
else fltrCName E.||. fltrCShort E.||. fltrCno
|
||||
)
|
||||
where
|
||||
where
|
||||
setFoldMap :: (Text -> Set.Set Text) -> Set.Set Text -> Set.Set Text
|
||||
setFoldMap = foldMap
|
||||
|
||||
@ -825,22 +829,22 @@ fltrCompanyNameNrHdrUI msg mPrev =
|
||||
---------
|
||||
|
||||
|
||||
fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k)
|
||||
fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k)
|
||||
=> (a -> E.SqlExpr (Entity User)) -> Map k (FilterColumn t fs)
|
||||
fltrAVSCardNos queryUser = Map.singleton "avs-card" fch
|
||||
where
|
||||
where
|
||||
fch = FilterColumnHandler $ \case
|
||||
[] -> return (const E.true)
|
||||
cs -> do
|
||||
let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs
|
||||
toutsecs <- getsYesod $ preview $ _appAvsConf . _Just . _avsTimeout
|
||||
maybeTimeoutHandler toutsecs (try $ queryAvsCardNos crds) >>= \case
|
||||
Nothing -> addMessageI Error MsgAvsCommunicationTimeout
|
||||
maybeTimeoutHandler toutsecs (try $ queryAvsCardNos crds) >>= \case
|
||||
Nothing -> addMessageI Error MsgAvsCommunicationTimeout
|
||||
>> return (const E.false)
|
||||
(Just (Left err)) -> addMessage Error (someExc2Html err)
|
||||
>> return (const E.false)
|
||||
(Just (Right (null -> True))) -> return (const E.false)
|
||||
(Just (Right apids)) -> return $
|
||||
(Just (Right apids)) -> return $
|
||||
\(queryUser -> user) ->
|
||||
E.exists $ E.from $ \usrAvs ->
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
|
||||
@ -849,8 +853,8 @@ fltrAVSCardNos queryUser = Map.singleton "avs-card" fch
|
||||
someExc2Html (SomeException e) = text2Html $ tshow e
|
||||
|
||||
fltrAVSCardNosUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrAVSCardNosUI mPrev =
|
||||
prismAForm (singletonFilter "avs-card" ) mPrev $
|
||||
fltrAVSCardNosUI mPrev =
|
||||
prismAForm (singletonFilter "avs-card" ) mPrev $
|
||||
aopt textField (fslI MsgAvsCardNo & setTooltip (SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded]))
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user