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

fix(build): minor haskell typos/errors

Browse Source 
The code was written without having a working compiler, hence some accidental code kinks remained.
This commit is contained in:
Steffen Jost 2025-03-28 08:58:35 +01:00
parent 3c6a580808
commit 64df38f2a9
2 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
backend/src/Handler/Tutorial/Users.hs
View File

@ -124,9 +124,9 @@ postTUsersR tid ssh csh tutn = do
-- tutEnt@(Entity tutid _) <- fetchTutorial tid ssh csh tutn -- tutEnt@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
(cid, tutEnt@(Entity tutid _)) <- fetchCourseIdTutorial tid ssh csh tutn (cid, tutEnt@(Entity tutid _)) <- fetchCourseIdTutorial tid ssh csh tutn
qualifications <- getCourseQualifications cid qualifications <- getCourseQualifications cid
let dayExpiry = case nubOrd (mapMaybe qualificationValidDuration qualifications) of let dayExpiry = case nubOrd (mapMaybe (view _qualificationValidDuration) qualifications) of
[oneDuration] -> Just $ Just $ computeNewValidDate qvd nowaday -- suggest end day only if it is unique for all course qualifications [oneDuration] -> Just $ Just $ computeNewValidDate oneDuration nowaday -- suggest end day only if it is unique for all course qualifications
_ -> Nothing -- using the minimum here causes confusion, better leave blank! _ -> Nothing -- using the minimum here causes confusion, better leave blank!
colChoices = mconcat $ colChoices = mconcat $
[ dbSelect (applying _2) id (return . view (hasEntity . _entityKey)) [ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
, colUserNameModalHdr MsgTableCourseMembers ForProfileDataR , colUserNameModalHdr MsgTableCourseMembers ForProfileDataR
@ -205,25 +205,26 @@ postTUsersR tid ssh csh tutn = do
-- typePDF = "application/pdf" -- typePDF = "application/pdf"
-- sendResponse (typePDF, toContent pdf) -- sendResponse (typePDF, toContent pdf)
(TutorialUserGrantQualificationData{..}, selectedUsers) (TutorialUserGrantQualificationData{..}, selectedUsers)
| Just grantQual <- Map.lookup tuQualification courseQids -> | Just grantQual <- Map.lookup tuQualification courseQids ->
case tuValidUntil <|> (flip computeNewValidDate nowaday <$> qualificationValidDuration grantQual) of case tuValidUntil <|> (flip computeNewValidDate nowaday <$> qualificationValidDuration grantQual) of
Nothing -> do -- TODO: change QualificationUser to have an optionnal validUntil for idefinitely valid qualifications Nothing -> do -- TODO: change QualificationUser to have an optionnal validUntil for idefinitely valid qualifications
addMessageI Error $ MsgTutorialUserGrantQualificationDateError $ qualificationShorthand grantQual addMessageI Error $ MsgTutorialUserGrantQualificationDateError $ qualificationShorthand grantQual
(Just expiryDay) -> do return Nothing
(Just expiryDay) -> do
let qsh = qualificationShorthand grantQual let qsh = qualificationShorthand grantQual
reason = "Kurs " <> CI.original (unSchoolKey ssh) <> "-" <> CI.original csh <> "-" <> CI.original tutn reason = "Kurs " <> CI.original (unSchoolKey ssh) <> "-" <> CI.original csh <> "-" <> CI.original tutn
selUsrs = Set.toList selectedUsers selUsrs = Set.toList selectedUsers
expiryDayText <- formatTime SelFormatDate expiryDay expiryDayText <- formatTime SelFormatDate expiryDay
nterm <- runDB $ do nterm <- runDB $ do
forM_ selUsrs $ upsertQualificationUser tuQualification now expiryDay Nothing reason forM_ selUsrs $ upsertQualificationUser tuQualification now expiryDay Nothing reason
terminateLms (LmsOrphanReasonManualGrant [st|bis #{expiryDayText}, #{reason}|]) tuQualification selUsrs terminateLms (LmsOrphanReasonManualGrant [st|bis #{expiryDayText}, #{reason}|]) tuQualification selUsrs
addMessageI (if 0 < Set.size selectedUsers then Success else Warning) . MsgTutorialUserGrantedQualification qsh expiryDayText $ Set.size selectedUsers addMessageI (if 0 < Set.size selectedUsers then Success else Warning) . MsgTutorialUserGrantedQualification qsh expiryDayText $ Set.size selectedUsers
when (nterm > 0) $ addMessageI Warning $ MsgLmsActTerminated nterm when (nterm > 0) $ addMessageI Warning $ MsgLmsActTerminated nterm
reloadKeepGetParams croute reloadKeepGetParams croute
(TutorialUserRenewQualificationData{..}, selectedUsers) (TutorialUserRenewQualificationData{..}, selectedUsers)
| Just grantQual <- Map.lookup tuQualification courseQids -> do | Just grantQual <- Map.lookup tuQualification courseQids -> do
let qsh = qualificationShorthand grantQual let qsh = qualificationShorthand grantQual
selUsrs = Set.toList selectedUsers selUsrs = Set.toList selectedUsers
mr <- getMessageRender mr <- getMessageRender
(noks,nterm) <- runDB $ (,) (noks,nterm) <- runDB $ (,)
<$> renewValidQualificationUsers tuQualification Nothing Nothing selUsrs <$> renewValidQualificationUsers tuQualification Nothing Nothing selUsrs

4
backend/src/Utils.hs
View File

@ -934,8 +934,8 @@ setToMap mkKey = Map.fromList . fmap (\x -> (mkKey x, x)) . Set.toList
-- Create a Map given a key-computation -- Create a Map given a key-computation
-- For Entity, use Utils.DB.entities2map instead -- For Entity, use Utils.DB.entities2map instead
mapFromFoldable :: (Ord k, Foldable t) => (v -> k) -> t v -> Map k v mapFromFoldable :: (Ord k, MonoFoldable mono) => (Element mono -> k) -> mono -> Map k (Element mono)
mapFromFoldable getKey = foldMap (Map.singleton =<< getKey) mapFromFoldable getKey = ofoldMap (Map.singleton =<< getKey)
mapFM :: (Applicative m, Ord k, Finite k) => (k -> m v) -> m (Map k v) mapFM :: (Applicative m, Ord k, Finite k) => (k -> m v) -> m (Map k v)
mapFM = sequenceA . mapF mapFM = sequenceA . mapF