mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-08-17 20:00:30 +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."
|
vBox [ str "This text uses the global default attribute."
|
||||||
, withAttr (attrName "foundFull") $
|
, withAttr (attrName "foundFull") $
|
||||||
str "Specifying an attribute name means we look it up in the attribute tree."
|
str "Specifying an attribute name means we look it up in the attribute tree."
|
||||||
, (withAttr (attrName "foundFgOnly") $
|
, withAttr (attrName "foundFgOnly") $
|
||||||
str ("When we find a value, we merge it with its parent in the attribute")
|
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).")
|
<=> str "name tree all the way to the root (the global default)."
|
||||||
, withAttr (attrName "missing") $
|
, withAttr (attrName "missing") $
|
||||||
str "A missing attribute name just resumes the search at its parent."
|
str "A missing attribute name just resumes the search at its parent."
|
||||||
, withAttr (attrName "general" <> attrName "specific") $
|
, withAttr (attrName "general" <> attrName "specific") $
|
||||||
@ -42,7 +42,7 @@ ui =
|
|||||||
, withAttr (attrName "foundFgOnly") $
|
, withAttr (attrName "foundFgOnly") $
|
||||||
str "... or only what you want to change and inherit the rest."
|
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 "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 " "
|
, str " "
|
||||||
, withAttr (attrName "linked") $
|
, withAttr (attrName "linked") $
|
||||||
str "This text is hyperlinked in terminals that support hyperlinking."
|
str "This text is hyperlinked in terminals that support hyperlinking."
|
||||||
|
@ -27,7 +27,7 @@ import qualified Graphics.Vty as V
|
|||||||
|
|
||||||
example :: Widget n
|
example :: Widget n
|
||||||
example =
|
example =
|
||||||
border $
|
border
|
||||||
(txt "Example" <=> txt "Widget")
|
(txt "Example" <=> txt "Widget")
|
||||||
|
|
||||||
mkExample :: Widget n -> Widget n
|
mkExample :: Widget n -> Widget n
|
||||||
|
@ -12,13 +12,10 @@ import Control.Monad (void)
|
|||||||
import qualified Graphics.Vty as V
|
import qualified Graphics.Vty as V
|
||||||
|
|
||||||
import qualified Brick.Types as T
|
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.Main as M
|
||||||
import qualified Brick.Widgets.Border as B
|
import qualified Brick.Widgets.Border as B
|
||||||
import qualified Brick.Widgets.Center as C
|
import qualified Brick.Widgets.Center as C
|
||||||
import Brick.Types
|
|
||||||
( Location(..)
|
|
||||||
)
|
|
||||||
import Brick.Widgets.Core
|
import Brick.Widgets.Core
|
||||||
( translateBy
|
( translateBy
|
||||||
, str
|
, str
|
||||||
|
@ -130,7 +130,7 @@ appEvent _ = return ()
|
|||||||
|
|
||||||
theme :: AttrMap
|
theme :: AttrMap
|
||||||
theme =
|
theme =
|
||||||
attrMap V.defAttr $
|
attrMap V.defAttr
|
||||||
[ (scrollbarAttr, fg V.white)
|
[ (scrollbarAttr, fg V.white)
|
||||||
, (scrollbarHandleAttr, fg V.brightYellow)
|
, (scrollbarHandleAttr, fg V.brightYellow)
|
||||||
]
|
]
|
||||||
|
@ -47,7 +47,7 @@ import qualified Data.Semigroup as Sem
|
|||||||
import Control.DeepSeq
|
import Control.DeepSeq
|
||||||
import Data.Bits ((.|.))
|
import Data.Bits ((.|.))
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (mapMaybe)
|
||||||
import Data.List (inits)
|
import Data.List (inits)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
|
|
||||||
@ -150,7 +150,7 @@ attrMapLookup :: AttrName -> AttrMap -> Attr
|
|||||||
attrMapLookup _ (ForceAttr a) = a
|
attrMapLookup _ (ForceAttr a) = a
|
||||||
attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault
|
attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault
|
||||||
attrMapLookup (AttrName ns) (AttrMap theDefault m) =
|
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
|
in foldl combineAttrs theDefault results
|
||||||
|
|
||||||
-- | Set the default attribute value in an attribute map.
|
-- | Set the default attribute value in an attribute map.
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
{-# LANGUAGE DeriveFunctor #-}
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DeriveAnyClass #-}
|
{-# LANGUAGE DeriveAnyClass #-}
|
||||||
module Brick.BorderMap
|
module Brick.BorderMap
|
||||||
|
@ -281,7 +281,7 @@ newForm :: [s -> FormFieldState s e n]
|
|||||||
newForm mkEs s =
|
newForm mkEs s =
|
||||||
let es = mkEs <*> pure s
|
let es = mkEs <*> pure s
|
||||||
in Form { formFieldStates = es
|
in Form { formFieldStates = es
|
||||||
, formFocus = focusRing $ concat $ formFieldNames <$> es
|
, formFocus = focusRing $ concatMap formFieldNames es
|
||||||
, formState = s
|
, formState = s
|
||||||
, formConcatAll = vBox
|
, 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
|
csr = if foc then putCursor name (Location (1,0)) else id
|
||||||
in clickable name $
|
in clickable name $
|
||||||
addAttr $ csr $
|
addAttr $ csr $
|
||||||
txt $ T.concat $
|
txt $ T.concat
|
||||||
[ T.singleton lb
|
[ T.singleton lb
|
||||||
, if isSet then T.singleton check else " "
|
, if isSet then T.singleton check else " "
|
||||||
, T.singleton rb <> " " <> label
|
, T.singleton rb <> " " <> label
|
||||||
@ -664,7 +664,7 @@ allFieldsValid = null . invalidFields
|
|||||||
-- force the user to repair invalid inputs before moving on from a form
|
-- force the user to repair invalid inputs before moving on from a form
|
||||||
-- editing session.
|
-- editing session.
|
||||||
invalidFields :: Form s e n -> [n]
|
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
|
-- | Manually indicate that a field has invalid contents. This can be
|
||||||
-- useful in situations where validation beyond the form element's
|
-- 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 s e n -> [n]
|
||||||
getInvalidFields (FormFieldState st _ _ fs _ _) =
|
getInvalidFields (FormFieldState st _ _ fs _ _) =
|
||||||
let gather (FormField n validate extValid _ _) =
|
let gather (FormField n validate extValid _ _) =
|
||||||
if (not extValid || (isNothing $ validate st)) then [n] else []
|
if not extValid || isNothing (validate st) then [n] else []
|
||||||
in concat $ gather <$> fs
|
in concatMap gather fs
|
||||||
|
|
||||||
-- | Render a form.
|
-- | Render a form.
|
||||||
--
|
--
|
||||||
|
@ -172,7 +172,7 @@ buildKeyDispatcherPairs ks conf = pairs
|
|||||||
where
|
where
|
||||||
pairs = mkPair <$> handlers
|
pairs = mkPair <$> handlers
|
||||||
mkPair h = (khBinding h, h)
|
mkPair h = (khBinding h, h)
|
||||||
handlers = concat $ keyHandlersFromConfig conf <$> ks
|
handlers = concatMap (keyHandlersFromConfig conf) ks
|
||||||
|
|
||||||
keyHandlersFromConfig :: (Ord k)
|
keyHandlersFromConfig :: (Ord k)
|
||||||
=> KeyConfig k
|
=> KeyConfig k
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
-- | Basic types used by this library.
|
-- | Basic types used by this library.
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
module Brick.Types
|
module Brick.Types
|
||||||
|
@ -1,4 +1,3 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DeriveAnyClass #-}
|
{-# LANGUAGE DeriveAnyClass #-}
|
||||||
-- | This module provides styles for borders as used in terminal
|
-- | This module provides styles for borders as used in terminal
|
||||||
|
@ -691,9 +691,9 @@ renderBox br ws =
|
|||||||
paddedImages = padImage <$> rewrittenImages
|
paddedImages = padImage <$> rewrittenImages
|
||||||
|
|
||||||
cropResultToContext $ Result (concatenatePrimary br paddedImages)
|
cropResultToContext $ Result (concatenatePrimary br paddedImages)
|
||||||
(concat $ cursors <$> allTranslatedResults)
|
(concatMap cursors allTranslatedResults)
|
||||||
(concat $ visibilityRequests <$> allTranslatedResults)
|
(concatMap visibilityRequests allTranslatedResults)
|
||||||
(concat $ extents <$> allTranslatedResults)
|
(concatMap extents allTranslatedResults)
|
||||||
newBorders
|
newBorders
|
||||||
|
|
||||||
catDynBorder
|
catDynBorder
|
||||||
@ -1430,10 +1430,10 @@ viewport vpname typ p =
|
|||||||
|
|
||||||
-- If the rendering state includes any scrolling requests for this
|
-- If the rendering state includes any scrolling requests for this
|
||||||
-- viewport, apply those
|
-- viewport, apply those
|
||||||
reqs <- lift $ gets $ (^.rsScrollRequestsL)
|
reqs <- lift $ gets (^.rsScrollRequestsL)
|
||||||
let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs
|
let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs
|
||||||
when (not $ null relevantRequests) $ do
|
when (not $ null relevantRequests) $ do
|
||||||
mVp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))
|
mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname))
|
||||||
case mVp of
|
case mVp of
|
||||||
Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"
|
Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"
|
||||||
Just vp -> do
|
Just vp -> do
|
||||||
@ -1451,7 +1451,7 @@ viewport vpname typ p =
|
|||||||
-- If the sub-rendering requested visibility, update the scroll
|
-- If the sub-rendering requested visibility, update the scroll
|
||||||
-- state accordingly
|
-- state accordingly
|
||||||
when (not $ null $ initialResult^.visibilityRequestsL) $ do
|
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
|
case mVp of
|
||||||
Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"
|
Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"
|
||||||
Just vp -> do
|
Just vp -> do
|
||||||
@ -1464,7 +1464,7 @@ viewport vpname typ p =
|
|||||||
|
|
||||||
-- If the size of the rendering changes enough to make the
|
-- If the size of the rendering changes enough to make the
|
||||||
-- viewport offsets invalid, reset them
|
-- 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
|
vp <- case mVp of
|
||||||
Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"
|
Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"
|
||||||
Just v -> return v
|
Just v -> return v
|
||||||
|
@ -12,10 +12,9 @@ import Lens.Micro ((^.), (&), (%~))
|
|||||||
import Lens.Micro.Mtl ((%=))
|
import Lens.Micro.Mtl ((%=))
|
||||||
import Control.Monad.State.Strict
|
import Control.Monad.State.Strict
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Data.Maybe (catMaybes)
|
|
||||||
import qualified Graphics.Vty as V
|
import qualified Graphics.Vty as V
|
||||||
|
|
||||||
import Brick.Types
|
import Brick.Types
|
||||||
@ -63,7 +62,7 @@ renderFinal aMap layerRenders (w, h) chooseCursor rs =
|
|||||||
}
|
}
|
||||||
|
|
||||||
layersTopmostFirst = reverse layerResults
|
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.
|
-- picWithBg is a workaround for runaway attributes.
|
||||||
-- See https://github.com/coreyoconnor/vty/issues/95
|
-- 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)
|
cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL)
|
||||||
|
|
||||||
cropCursors :: Context n -> [CursorLocation n] -> [CursorLocation n]
|
cropCursors :: Context n -> [CursorLocation n] -> [CursorLocation n]
|
||||||
cropCursors ctx cs = catMaybes $ cropCursor <$> cs
|
cropCursors ctx cs = mapMaybe cropCursor cs
|
||||||
where
|
where
|
||||||
-- A cursor location is removed if it is not within the region
|
-- A cursor location is removed if it is not within the region
|
||||||
-- described by the context.
|
-- described by the context.
|
||||||
@ -105,7 +104,7 @@ cropCursors ctx cs = catMaybes $ cropCursor <$> cs
|
|||||||
]
|
]
|
||||||
|
|
||||||
cropExtents :: Context n -> [Extent n] -> [Extent n]
|
cropExtents :: Context n -> [Extent n] -> [Extent n]
|
||||||
cropExtents ctx es = catMaybes $ cropExtent <$> es
|
cropExtents ctx es = mapMaybe cropExtent es
|
||||||
where
|
where
|
||||||
-- An extent is cropped in places where it is not within the
|
-- An extent is cropped in places where it is not within the
|
||||||
-- region described by the context.
|
-- region described by the context.
|
||||||
|
@ -1,8 +1,6 @@
|
|||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE DeriveFunctor #-}
|
|
||||||
{-# LANGUAGE DeriveFoldable#-}
|
|
||||||
{-# LANGUAGE DeriveTraversable #-}
|
{-# LANGUAGE DeriveTraversable #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
@ -4,7 +4,6 @@
|
|||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE TypeSynonymInstances #-}
|
|
||||||
module List
|
module List
|
||||||
( main
|
( main
|
||||||
)
|
)
|
||||||
|
@ -112,5 +112,5 @@ return []
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main =
|
main =
|
||||||
(all id <$> sequenceA [$quickCheckAll, List.main, Render.main])
|
(and <$> sequenceA [$quickCheckAll, List.main, Render.main])
|
||||||
>>= bool exitFailure exitSuccess
|
>>= bool exitFailure exitSuccess
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
|
||||||
module Render
|
module Render
|
||||||
( main
|
( main
|
||||||
)
|
)
|
||||||
|
Loading…
Reference in New Issue
Block a user