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

chore(daily): fix #2349 completing daily sanity check

Browse Source
This commit is contained in:
Steffen Jost 2024-12-02 13:28:33 +01:00 committed by Sarah Vaupel
parent ad1d235bea
commit f47528c741
1 changed files with 43 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
src/Handler/School/DayTasks.hs
View File

@ -449,8 +449,8 @@ colParkingField' l dday = sortable (Just "parking") (i18nCell $ MsgTableUserPark
over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
) )
mkDailyTable :: Bool -> SchoolId -> Day -> DB (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData), Maybe Widget) mkDailyTable :: Bool -> SchoolId -> Day -> Maybe DayCheckResults -> DB (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData), Maybe Widget)
mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case mkDailyTable isAdmin ssh nd dcrs = getDayTutorials ssh (nd,nd) >>= \case
tutLessons tutLessons
| Map.null tutLessons -> return (FormMissing, Nothing) | Map.null tutLessons -> return (FormMissing, Nothing)
| otherwise -> do | otherwise -> do
@ -500,10 +500,10 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
result result
| primComp /= bookComp | primComp /= bookComp
, Just (unCompanyKey -> csh) <- primComp , Just (unCompanyKey -> csh) <- primComp
= bookLink = cell (iconTooltip [whamlet|_{MsgAvsPrimaryCompany}: ^{companyWidget True (csh, csh, False)}|]
(Just IconCompanyWarning) True)
<> spacerCell <> spacerCell
<> cell (iconTooltip [whamlet|_{MsgAvsPrimaryCompany}: ^{companyWidget True (csh, csh, False)}|] <> bookLink
(Just IconCompanyWarning) True)
| otherwise = bookLink | otherwise = bookLink
in result in result
-- , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \row -> -- , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \row ->
@ -526,6 +526,9 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
-- )) -- ))
-- | otherwise = bookLink -- | otherwise = bookLink
-- in result -- in result
, maybeEmpty dcrs $ \DayCheckResults{..} ->
sortable (Just "check-fail") (timeCell dcrTimestamp) $ \(view $ resultParticipant . _entityKey -> tpid) ->
maybeCell (Map.lookup tpid dcrResults) $ wgtCell . dcr2widget' Nothing
, colUserNameModalHdr MsgCourseParticipant ForProfileDataR , colUserNameModalHdr MsgCourseParticipant ForProfileDataR
, colUserMatriclenr isAdmin , colUserMatriclenr isAdmin
, sortable (Just "card-no") (i18nCell MsgAvsCardNo) $ \(preview $ resultUserAvs . _userAvsLastCardNo . _Just -> cn :: Maybe AvsFullCardNo) -> cellMaybe (textCell . tshowAvsFullCardNo) cn , sortable (Just "card-no") (i18nCell MsgAvsCardNo) $ \(preview $ resultUserAvs . _userAvsLastCardNo . _Just -> cn :: Maybe AvsFullCardNo) -> cellMaybe (textCell . tshowAvsFullCardNo) cn
@ -557,6 +560,16 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
, ("attendance" , SortColumnNullsInv $ queryParticipantDay >>> (E.?. TutorialParticipantDayAttendance)) , ("attendance" , SortColumnNullsInv $ queryParticipantDay >>> (E.?. TutorialParticipantDayAttendance))
, ("note-attend" , SortColumn $ queryParticipantDay >>> (E.?. TutorialParticipantDayNote)) , ("note-attend" , SortColumn $ queryParticipantDay >>> (E.?. TutorialParticipantDayNote))
, ("parking" , SortColumnNullsInv $ queryUserDay >>> (E.?. UserDayParkingToken)) , ("parking" , SortColumnNullsInv $ queryUserDay >>> (E.?. UserDayParkingToken))
-- , ("check-fail" , SortColumn $ queryParticipant >>> (\pid -> pid E.^. TutorialParticipantId `E.in_` E.vals (maybeEmpty dcrs $ dcrResults >>> Map.keys)))
, let dcrsLevels = maybeEmpty dcrs $ dcrSeverityGroups . dcrResults in
("check-fail" , SortColumn $ queryParticipant >>> (\((E.^. TutorialParticipantId) -> pid) -> E.case_
[ E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _1)) E.then_ (E.val 1)
, E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _2)) E.then_ (E.val 2)
, E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _3)) E.then_ (E.val 3)
, E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _4)) E.then_ (E.val 4)
, E.when_ (pid `E.in_` E.vals (dcrsLevels ^. _5)) E.then_ (E.val 5)
](E.else_ E.val (99 :: Int64))
))
] ]
dbtFilter = Map.fromList dbtFilter = Map.fromList
[ fltrUserNameEmail queryUser [ fltrUserNameEmail queryUser
@ -630,7 +643,8 @@ postSchoolDayR ssh nd = do
, dailyFormAttendanceNote = row ^? resultParticipantDay ._tutorialParticipantDayNote . _Just , dailyFormAttendanceNote = row ^? resultParticipantDay ._tutorialParticipantDayNote . _Just
, dailyFormParkingToken = row ^? resultUserDay . _userDayParkingToken & fromMaybe False , dailyFormParkingToken = row ^? resultUserDay . _userDayParkingToken & fromMaybe False
} }
(fmap unFormResult -> tableRes, tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd dcrs <- memcachedByGet (CacheKeyTutorialCheckResults ssh nd)
(fmap unFormResult -> tableRes, tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd dcrs
-- logInfoS "****DailyTable****" $ tshow tableRes -- logInfoS "****DailyTable****" $ tshow tableRes
formResult tableRes $ \resMap -> do formResult tableRes $ \resMap -> do
tuts <- runDB $ forM (Map.toList resMap) $ \(tpid, DailyFormData{..}) -> do tuts <- runDB $ forM (Map.toList resMap) $ \(tpid, DailyFormData{..}) -> do
@ -720,6 +734,29 @@ dcr2widget _ DayCheckResult{dcEyeFitsPermit=Nothing} = text2widget "Sehtest
dcr2widget _ DayCheckResult{dcEyeFitsPermit=Just False}= text2widget "Sehtest und Führerschein passen nicht zusammen" dcr2widget _ DayCheckResult{dcEyeFitsPermit=Just False}= text2widget "Sehtest und Führerschein passen nicht zusammen"
dcr2widget _ _ = text2widget "Kein Problem vorhanden" dcr2widget _ _ = text2widget "Kein Problem vorhanden"
dcrSeverity :: DayCheckResult -> Int
dcrSeverity DayCheckResult{dcAvsKnown=False} = 1
dcrSeverity DayCheckResult{dcApronAccess=False} = 2
dcrSeverity DayCheckResult{dcBookingFirmOk=False} = 3
dcrSeverity DayCheckResult{dcEyeFitsPermit=Nothing} = 4
dcrSeverity DayCheckResult{dcEyeFitsPermit=Just False} = 5
dcrSeverity _ = 99
dcrSeverityGroups :: Map TutorialParticipantId DayCheckResult -> (Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId)
dcrSeverityGroups dcrs = Map.foldMapWithKey groupBySeverity mempty
where
groupBySeverity :: TutorialParticipantId -> DayCheckResult -> (Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId)
groupBySeverity tpid dcr =
let sempty = mempty :: (Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId)
in case dcrSeverity dcr of
1 -> set _1 (Set.singleton tpid) sempty
2 -> set _2 (Set.singleton tpid) sempty
3 -> set _3 (Set.singleton tpid) sempty
4 -> set _4 (Set.singleton tpid) sempty
5 -> set _5 (Set.singleton tpid) sempty
_ -> sempty
-- Alternative version using icons to display everything at once -- Alternative version using icons to display everything at once
dcr2widget' :: Maybe CompanyName -> DayCheckResult -> Widget dcr2widget' :: Maybe CompanyName -> DayCheckResult -> Widget
dcr2widget' mcn DayCheckResult{..} = mconcat [avsChk, apronChk, bookChk, permitChk] dcr2widget' mcn DayCheckResult{..} = mconcat [avsChk, apronChk, bookChk, permitChk]