fix(build): minor haskell typos/errors

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

View File

@ -124,8 +124,8 @@ postTUsersR tid ssh csh tutn = do
-- tutEnt@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
(cid, tutEnt@(Entity tutid _)) <- fetchCourseIdTutorial tid ssh csh tutn
qualifications <- getCourseQualifications cid
let dayExpiry = case nubOrd (mapMaybe qualificationValidDuration qualifications) of
[oneDuration] -> Just $ Just $ computeNewValidDate qvd nowaday -- suggest end day only if it is unique for all course qualifications
let dayExpiry = case nubOrd (mapMaybe (view _qualificationValidDuration) qualifications) of
[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!
colChoices = mconcat $
[ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
@ -209,6 +209,7 @@ postTUsersR tid ssh csh tutn = do
case tuValidUntil <|> (flip computeNewValidDate nowaday <$> qualificationValidDuration grantQual) of
Nothing -> do -- TODO: change QualificationUser to have an optionnal validUntil for idefinitely valid qualifications
addMessageI Error $ MsgTutorialUserGrantQualificationDateError $ qualificationShorthand grantQual
return Nothing
(Just expiryDay) -> do
let qsh = qualificationShorthand grantQual
reason = "Kurs " <> CI.original (unSchoolKey ssh) <> "-" <> CI.original csh <> "-" <> CI.original tutn

View File

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