mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-08-17 11:50:24 +03:00
Fix some hlint warnings
This commit is contained in:
parent
a9fd2f15d1
commit
3bd2235c0c
@ -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."
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -130,7 +130,7 @@ appEvent _ = return ()
|
||||
|
||||
theme :: AttrMap
|
||||
theme =
|
||||
attrMap V.defAttr $
|
||||
attrMap V.defAttr
|
||||
[ (scrollbarAttr, fg V.white)
|
||||
, (scrollbarHandleAttr, fg V.brightYellow)
|
||||
]
|
||||
|
@ -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.
|
||||
|
@ -1,6 +1,5 @@
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
module Brick.BorderMap
|
||||
|
@ -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.
|
||||
--
|
||||
|
@ -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
|
||||
|
@ -1,5 +1,4 @@
|
||||
-- | Basic types used by this library.
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Brick.Types
|
||||
|
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
-- | This module provides styles for borders as used in terminal
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -1,8 +1,6 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveFoldable#-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
@ -4,7 +4,6 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
module List
|
||||
( main
|
||||
)
|
||||
|
@ -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
|
||||
|
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
module Render
|
||||
( main
|
||||
)
|
||||
|
Loading…
Reference in New Issue
Block a user