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

fix(hlint): implement hlint suggestion

Browse Source
This commit is contained in:
Steffen Jost 2024-12-03 11:58:30 +01:00 committed by Sarah Vaupel
parent b42e93e891
commit 5f3d8a88e2
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Foundation/SiteLayout.hs
View File

@ -156,7 +156,7 @@ siteLayout' overrideHeading widget = do
-- isParent r = r == (fst parents) -- isParent r = r == (fst parents)
isAuth <- isJust <$> maybeAuthId isAuth <- isJust <$> maybeAuthId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
muid <- maybeAuthPair muid <- maybeAuthPair
@ -254,7 +254,7 @@ siteLayout' overrideHeading widget = do
forM_ authTagPivots $ forM_ authTagPivots $
\authTag -> addMessageWidget Info $ msgModal [whamlet|_{MsgUnauthorizedDisabledTag authTag}|] (Left $ SomeRoute (AuthPredsR, catMaybes [(toPathPiece GetReferer, ) . toPathPiece <$> mcurrentRoute])) \authTag -> addMessageWidget Info $ msgModal [whamlet|_{MsgUnauthorizedDisabledTag authTag}|] (Left $ SomeRoute (AuthPredsR, catMaybes [(toPathPiece GetReferer, ) . toPathPiece <$> mcurrentRoute]))
getMessages getMessages
storedReasonAndToggleRoute <- case mcurrentRoute of storedReasonAndToggleRoute <- case mcurrentRoute of
(Just (CourseR tid ssh csh _)) -> (, Just . SomeRoute $ CourseR tid ssh csh CFavouriteR) <$> storedFavouriteReason tid ssh csh muid (Just (CourseR tid ssh csh _)) -> (, Just . SomeRoute $ CourseR tid ssh csh CFavouriteR) <$> storedFavouriteReason tid ssh csh muid
_otherwise -> pure (Nothing, Nothing) _otherwise -> pure (Nothing, Nothing)
@ -266,8 +266,8 @@ siteLayout' overrideHeading widget = do
, nav' , nav'
, contentHeadline , contentHeadline
, mmsgs , mmsgs
, maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid , maybe userDefaultMaxFavouriteTerms (userMaxFavouriteTerms . view _2) muid
, maybe userDefaultTheme userTheme $ view _2 <$> muid , maybe userDefaultTheme (userTheme . view _2) muid
, storedReasonAndToggleRoute , storedReasonAndToggleRoute
) )
@ -299,7 +299,7 @@ siteLayout' overrideHeading widget = do
| otherwise = Set.drop (Set.size ts - n) ts | otherwise = Set.drop (Set.size ts - n) ts
currentTerms = toTermKeySet $ filter (views (_2 . _Value) . maybe True $ is _FavouriteCurrent) favourites' currentTerms = toTermKeySet $ filter (views (_2 . _Value) . maybe True $ is _FavouriteCurrent) favourites'
toTermKeySet = setOf $ folded . _1 . _2 . to unTermKey toTermKeySet = setOf $ folded . _1 . _2 . to unTermKey
favourites <- fmap catMaybes . forM favourites' $ \(c@(_, tid, ssh, csh), E.Value mFavourite, courseVisible, mayView, mayEdit) favourites <- fmap catMaybes . forM favourites' $ \(c@(_, tid, ssh, csh), E.Value mFavourite, courseVisible, mayView, mayEdit)
-> let courseRoute = CourseR tid ssh csh CShowR -> let courseRoute = CourseR tid ssh csh CShowR
favouriteReason = fromMaybe FavouriteCurrent mFavourite favouriteReason = fromMaybe FavouriteCurrent mFavourite
@ -508,7 +508,7 @@ siteLayout' overrideHeading widget = do
$(widgetFile "default-layout") $(widgetFile "default-layout")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
getSystemMessageState :: (MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => SystemMessageId -> m UserSystemMessageState getSystemMessageState :: (MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => SystemMessageId -> m UserSystemMessageState
getSystemMessageState smId = liftHandler $ do getSystemMessageState smId = liftHandler $ do
muid <- maybeAuthId muid <- maybeAuthId
@ -594,7 +594,7 @@ applySystemMessages = maybeT_ . catchMPlus (Proxy @CryptoIDError) $ do
-- FIXME: Move headings into their respective handlers -- FIXME: Move headings into their respective handlers
-- | Method for specifying page heading for handlers that call defaultLayout -- | Method for specifying page heading for handlers that call defaultLayout
-- --
-- All handlers whose code is under our control should use -- All handlers whose code is under our control should use