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:
parent
3c6a580808
commit
64df38f2a9
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user