From 3bd2235c0c97cbac577eade45b36940570e76274 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 24 Sep 2022 12:56:11 +0200 Subject: [PATCH] Fix some hlint warnings --- programs/AttrDemo.hs | 8 ++++---- programs/CroppingDemo.hs | 2 +- programs/LayerDemo.hs | 5 +---- programs/ViewportScrollbarsDemo.hs | 2 +- src/Brick/AttrMap.hs | 4 ++-- src/Brick/BorderMap.hs | 1 - src/Brick/Forms.hs | 10 +++++----- src/Brick/Keybindings/KeyDispatcher.hs | 2 +- src/Brick/Types.hs | 1 - src/Brick/Widgets/Border/Style.hs | 1 - src/Brick/Widgets/Core.hs | 14 +++++++------- src/Brick/Widgets/Internal.hs | 9 ++++----- src/Brick/Widgets/List.hs | 2 -- tests/List.hs | 1 - tests/Main.hs | 2 +- tests/Render.hs | 1 - 16 files changed, 27 insertions(+), 38 deletions(-) diff --git a/programs/AttrDemo.hs b/programs/AttrDemo.hs index ca0c44c..4f1c3ae 100644 --- a/programs/AttrDemo.hs +++ b/programs/AttrDemo.hs @@ -30,9 +30,9 @@ ui = vBox [ str "This text uses the global default attribute." , withAttr (attrName "foundFull") $ str "Specifying an attribute name means we look it up in the attribute tree." - , (withAttr (attrName "foundFgOnly") $ - str ("When we find a value, we merge it with its parent in the attribute") - <=> str "name tree all the way to the root (the global default).") + , withAttr (attrName "foundFgOnly") $ + str "When we find a value, we merge it with its parent in the attribute" + <=> str "name tree all the way to the root (the global default)." , withAttr (attrName "missing") $ str "A missing attribute name just resumes the search at its parent." , withAttr (attrName "general" <> attrName "specific") $ @@ -42,7 +42,7 @@ ui = , withAttr (attrName "foundFgOnly") $ str "... or only what you want to change and inherit the rest." , str "Attribute names are assembled with the Monoid append operation to indicate" - , str "hierarchy levels, e.g. \"window\" <> \"title\"." + , str "hierarchy levels, e.g. attrName \"window\" <> attrName \"title\"." , str " " , withAttr (attrName "linked") $ str "This text is hyperlinked in terminals that support hyperlinking." diff --git a/programs/CroppingDemo.hs b/programs/CroppingDemo.hs index e8fc139..42f67d7 100644 --- a/programs/CroppingDemo.hs +++ b/programs/CroppingDemo.hs @@ -27,7 +27,7 @@ import qualified Graphics.Vty as V example :: Widget n example = - border $ + border (txt "Example" <=> txt "Widget") mkExample :: Widget n -> Widget n diff --git a/programs/LayerDemo.hs b/programs/LayerDemo.hs index 0a0813c..8a54f65 100644 --- a/programs/LayerDemo.hs +++ b/programs/LayerDemo.hs @@ -12,13 +12,10 @@ import Control.Monad (void) import qualified Graphics.Vty as V import qualified Brick.Types as T -import Brick.Types (locationRowL, locationColumnL, Widget) +import Brick.Types (locationRowL, locationColumnL, Location(..), Widget) import qualified Brick.Main as M import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Center as C -import Brick.Types - ( Location(..) - ) import Brick.Widgets.Core ( translateBy , str diff --git a/programs/ViewportScrollbarsDemo.hs b/programs/ViewportScrollbarsDemo.hs index b514066..bf8cbd2 100644 --- a/programs/ViewportScrollbarsDemo.hs +++ b/programs/ViewportScrollbarsDemo.hs @@ -130,7 +130,7 @@ appEvent _ = return () theme :: AttrMap theme = - attrMap V.defAttr $ + attrMap V.defAttr [ (scrollbarAttr, fg V.white) , (scrollbarHandleAttr, fg V.brightYellow) ] diff --git a/src/Brick/AttrMap.hs b/src/Brick/AttrMap.hs index 30e04f2..30b7666 100644 --- a/src/Brick/AttrMap.hs +++ b/src/Brick/AttrMap.hs @@ -47,7 +47,7 @@ import qualified Data.Semigroup as Sem import Control.DeepSeq import Data.Bits ((.|.)) import qualified Data.Map as M -import Data.Maybe (catMaybes) +import Data.Maybe (mapMaybe) import Data.List (inits) import GHC.Generics (Generic) @@ -150,7 +150,7 @@ attrMapLookup :: AttrName -> AttrMap -> Attr attrMapLookup _ (ForceAttr a) = a attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault attrMapLookup (AttrName ns) (AttrMap theDefault m) = - let results = catMaybes $ (\n -> M.lookup n m) <$> (AttrName <$> (inits ns)) + let results = mapMaybe (\n -> M.lookup (AttrName n) m) (inits ns) in foldl combineAttrs theDefault results -- | Set the default attribute value in an attribute map. diff --git a/src/Brick/BorderMap.hs b/src/Brick/BorderMap.hs index 5ca3bec..a2aa567 100644 --- a/src/Brick/BorderMap.hs +++ b/src/Brick/BorderMap.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} module Brick.BorderMap diff --git a/src/Brick/Forms.hs b/src/Brick/Forms.hs index 87a4180..806c5ef 100644 --- a/src/Brick/Forms.hs +++ b/src/Brick/Forms.hs @@ -281,7 +281,7 @@ newForm :: [s -> FormFieldState s e n] newForm mkEs s = let es = mkEs <*> pure s in Form { formFieldStates = es - , formFocus = focusRing $ concat $ formFieldNames <$> es + , formFocus = focusRing $ concatMap formFieldNames es , formState = s , formConcatAll = vBox } @@ -482,7 +482,7 @@ renderRadio lb check rb val name label foc cur = csr = if foc then putCursor name (Location (1,0)) else id in clickable name $ addAttr $ csr $ - txt $ T.concat $ + txt $ T.concat [ T.singleton lb , if isSet then T.singleton check else " " , T.singleton rb <> " " <> label @@ -664,7 +664,7 @@ allFieldsValid = null . invalidFields -- force the user to repair invalid inputs before moving on from a form -- editing session. invalidFields :: Form s e n -> [n] -invalidFields f = concat $ getInvalidFields <$> formFieldStates f +invalidFields f = concatMap getInvalidFields (formFieldStates f) -- | Manually indicate that a field has invalid contents. This can be -- useful in situations where validation beyond the form element's @@ -695,8 +695,8 @@ setFieldValid v n form = getInvalidFields :: FormFieldState s e n -> [n] getInvalidFields (FormFieldState st _ _ fs _ _) = let gather (FormField n validate extValid _ _) = - if (not extValid || (isNothing $ validate st)) then [n] else [] - in concat $ gather <$> fs + if not extValid || isNothing (validate st) then [n] else [] + in concatMap gather fs -- | Render a form. -- diff --git a/src/Brick/Keybindings/KeyDispatcher.hs b/src/Brick/Keybindings/KeyDispatcher.hs index 73c724e..da65e58 100644 --- a/src/Brick/Keybindings/KeyDispatcher.hs +++ b/src/Brick/Keybindings/KeyDispatcher.hs @@ -172,7 +172,7 @@ buildKeyDispatcherPairs ks conf = pairs where pairs = mkPair <$> handlers mkPair h = (khBinding h, h) - handlers = concat $ keyHandlersFromConfig conf <$> ks + handlers = concatMap (keyHandlersFromConfig conf) ks keyHandlersFromConfig :: (Ord k) => KeyConfig k diff --git a/src/Brick/Types.hs b/src/Brick/Types.hs index c4070d2..64e965c 100644 --- a/src/Brick/Types.hs +++ b/src/Brick/Types.hs @@ -1,5 +1,4 @@ -- | Basic types used by this library. -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Brick.Types diff --git a/src/Brick/Widgets/Border/Style.hs b/src/Brick/Widgets/Border/Style.hs index 2791fc4..290eb7b 100644 --- a/src/Brick/Widgets/Border/Style.hs +++ b/src/Brick/Widgets/Border/Style.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} -- | This module provides styles for borders as used in terminal diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs index 3938860..68a1c74 100644 --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -691,9 +691,9 @@ renderBox br ws = paddedImages = padImage <$> rewrittenImages cropResultToContext $ Result (concatenatePrimary br paddedImages) - (concat $ cursors <$> allTranslatedResults) - (concat $ visibilityRequests <$> allTranslatedResults) - (concat $ extents <$> allTranslatedResults) + (concatMap cursors allTranslatedResults) + (concatMap visibilityRequests allTranslatedResults) + (concatMap extents allTranslatedResults) newBorders catDynBorder @@ -1430,10 +1430,10 @@ viewport vpname typ p = -- If the rendering state includes any scrolling requests for this -- viewport, apply those - reqs <- lift $ gets $ (^.rsScrollRequestsL) + reqs <- lift $ gets (^.rsScrollRequestsL) let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs when (not $ null relevantRequests) $ do - mVp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname)) + mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname)) case mVp of Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map" Just vp -> do @@ -1451,7 +1451,7 @@ viewport vpname typ p = -- If the sub-rendering requested visibility, update the scroll -- state accordingly when (not $ null $ initialResult^.visibilityRequestsL) $ do - mVp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname)) + mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname)) case mVp of Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map" Just vp -> do @@ -1464,7 +1464,7 @@ viewport vpname typ p = -- If the size of the rendering changes enough to make the -- viewport offsets invalid, reset them - mVp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname)) + mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname)) vp <- case mVp of Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map" Just v -> return v diff --git a/src/Brick/Widgets/Internal.hs b/src/Brick/Widgets/Internal.hs index eba0954..93e2d9d 100644 --- a/src/Brick/Widgets/Internal.hs +++ b/src/Brick/Widgets/Internal.hs @@ -12,10 +12,9 @@ import Lens.Micro ((^.), (&), (%~)) import Lens.Micro.Mtl ((%=)) import Control.Monad.State.Strict import Control.Monad.Reader -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Map as M import qualified Data.Set as S -import Data.Maybe (catMaybes) import qualified Graphics.Vty as V import Brick.Types @@ -63,7 +62,7 @@ renderFinal aMap layerRenders (w, h) chooseCursor rs = } layersTopmostFirst = reverse layerResults - pic = V.picForLayers $ uncurry V.resize (w, h) <$> (^.imageL) <$> layersTopmostFirst + pic = V.picForLayers $ V.resize w h <$> (^.imageL) <$> layersTopmostFirst -- picWithBg is a workaround for runaway attributes. -- See https://github.com/coreyoconnor/vty/issues/95 @@ -91,7 +90,7 @@ cropImage :: Context n -> V.Image -> V.Image cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL) cropCursors :: Context n -> [CursorLocation n] -> [CursorLocation n] -cropCursors ctx cs = catMaybes $ cropCursor <$> cs +cropCursors ctx cs = mapMaybe cropCursor cs where -- A cursor location is removed if it is not within the region -- described by the context. @@ -105,7 +104,7 @@ cropCursors ctx cs = catMaybes $ cropCursor <$> cs ] cropExtents :: Context n -> [Extent n] -> [Extent n] -cropExtents ctx es = catMaybes $ cropExtent <$> es +cropExtents ctx es = mapMaybe cropExtent es where -- An extent is cropped in places where it is not within the -- region described by the context. diff --git a/src/Brick/Widgets/List.hs b/src/Brick/Widgets/List.hs index 7c83898..d3f2287 100644 --- a/src/Brick/Widgets/List.hs +++ b/src/Brick/Widgets/List.hs @@ -1,8 +1,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveFoldable#-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} diff --git a/tests/List.hs b/tests/List.hs index 4a198bc..823898d 100644 --- a/tests/List.hs +++ b/tests/List.hs @@ -4,7 +4,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeSynonymInstances #-} module List ( main ) diff --git a/tests/Main.hs b/tests/Main.hs index 7288c59..e5a1218 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -112,5 +112,5 @@ return [] main :: IO () main = - (all id <$> sequenceA [$quickCheckAll, List.main, Render.main]) + (and <$> sequenceA [$quickCheckAll, List.main, Render.main]) >>= bool exitFailure exitSuccess diff --git a/tests/Render.hs b/tests/Render.hs index e8e486d..f355f2a 100644 --- a/tests/Render.hs +++ b/tests/Render.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE TypeApplications #-} module Render ( main )