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

7
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
@ -209,6 +209,7 @@ postTUsersR tid ssh csh tutn = do
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
return Nothing
(Just expiryDay) -> do (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

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