Respect NO_COLOR environment variable in list and tui
This commit is contained in:
Paolo Martini
parent
b20371c3ac
commit
a08e624309
@ -44,6 +44,7 @@ import Data.Vector ( Vector
|
||||
import Data.Versions hiding ( str )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import URI.ByteString
|
||||
@ -239,31 +240,39 @@ minHSize :: Int -> Widget n -> Widget n
|
||||
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
|
||||
|
||||
|
||||
app :: App BrickState e String
|
||||
app = App { appDraw = \st -> [ui st]
|
||||
, appHandleEvent = eventHandler
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const defaultAttributes
|
||||
, appChooseCursor = neverShowCursor
|
||||
}
|
||||
app :: AttrMap -> App BrickState e String
|
||||
app attributes =
|
||||
App { appDraw = \st -> [ui st]
|
||||
, appHandleEvent = eventHandler
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const attributes
|
||||
, appChooseCursor = neverShowCursor
|
||||
}
|
||||
|
||||
defaultAttributes :: AttrMap
|
||||
defaultAttributes = attrMap
|
||||
defaultAttributes :: Bool -> AttrMap
|
||||
defaultAttributes no_color = attrMap
|
||||
Vty.defAttr
|
||||
[ ("active" , Vty.defAttr `Vty.withBackColor` Vty.blue)
|
||||
, ("not-installed", Vty.defAttr `Vty.withForeColor` Vty.red)
|
||||
, ("set" , Vty.defAttr `Vty.withForeColor` Vty.green)
|
||||
, ("installed" , Vty.defAttr `Vty.withForeColor` Vty.green)
|
||||
, ("recommended" , Vty.defAttr `Vty.withForeColor` Vty.green)
|
||||
, ("hls-powered" , Vty.defAttr `Vty.withForeColor` Vty.green)
|
||||
, ("latest" , Vty.defAttr `Vty.withForeColor` Vty.yellow)
|
||||
, ("prerelease" , Vty.defAttr `Vty.withForeColor` Vty.red)
|
||||
, ("compiled" , Vty.defAttr `Vty.withForeColor` Vty.blue)
|
||||
, ("stray" , Vty.defAttr `Vty.withForeColor` Vty.blue)
|
||||
, ("help" , Vty.defAttr `Vty.withStyle` Vty.italic)
|
||||
, ("hooray" , Vty.defAttr `Vty.withForeColor` Vty.brightWhite)
|
||||
[ ("active" , Vty.defAttr `withBackColor` Vty.blue)
|
||||
, ("not-installed", Vty.defAttr `withForeColor` Vty.red)
|
||||
, ("set" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, ("installed" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, ("recommended" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, ("hls-powered" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, ("latest" , Vty.defAttr `withForeColor` Vty.yellow)
|
||||
, ("prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, ("compiled" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, ("stray" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, ("help" , Vty.defAttr `withStyle` Vty.italic)
|
||||
, ("hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
||||
]
|
||||
where
|
||||
withForeColor | no_color = const
|
||||
| otherwise = Vty.withForeColor
|
||||
|
||||
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
|
||||
| otherwise = Vty.withBackColor
|
||||
|
||||
withStyle = Vty.withStyle
|
||||
|
||||
dimAttributes :: AttrMap
|
||||
dimAttributes = attrMap
|
||||
@ -520,11 +529,13 @@ brickMain s l av pfreq' = do
|
||||
writeIORef logger' l
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
attributes <- defaultAttributes <$> isJust <$> lookupEnv "NO_COLOR"
|
||||
|
||||
eAppData <- getAppData (Just av) pfreq'
|
||||
case eAppData of
|
||||
Right ad ->
|
||||
defaultMain
|
||||
app
|
||||
(app attributes)
|
||||
(BrickState ad
|
||||
defaultAppSettings
|
||||
(constructList ad defaultAppSettings Nothing)
|
||||
|
||||
@ -59,7 +59,8 @@ import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import Safe
|
||||
import System.Console.Pretty
|
||||
import System.Console.Pretty hiding ( color )
|
||||
import qualified System.Console.Pretty as Pretty
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO hiding ( appendFile )
|
||||
@ -1531,6 +1532,20 @@ printListResult raw lr = do
|
||||
-- https://gitlab.haskell.org/ghc/ghc/issues/8118
|
||||
setLocaleEncoding utf8
|
||||
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
|
||||
let
|
||||
color | raw || no_color = flip const
|
||||
| otherwise = Pretty.color
|
||||
|
||||
let
|
||||
printTag Recommended = color Green "recommended"
|
||||
printTag Latest = color Yellow "latest"
|
||||
printTag Prerelease = color Red "prerelease"
|
||||
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||
printTag (UnknownTag t ) = t
|
||||
printTag Old = ""
|
||||
|
||||
let
|
||||
rows =
|
||||
(\x -> if raw
|
||||
@ -1552,13 +1567,13 @@ printListResult raw lr = do
|
||||
, intercalate "," $ (filter (/= "") . fmap printTag $ sort lTag)
|
||||
, intercalate ","
|
||||
$ (if hlsPowered
|
||||
then [color' Green "hls-powered"]
|
||||
then [color Green "hls-powered"]
|
||||
else mempty
|
||||
)
|
||||
++ (if fromSrc then [color' Blue "compiled"] else mempty)
|
||||
++ (if lStray then [color' Yellow "stray"] else mempty)
|
||||
++ (if fromSrc then [color Blue "compiled"] else mempty)
|
||||
++ (if lStray then [color Yellow "stray"] else mempty)
|
||||
++ (if lNoBindist
|
||||
then [color' Red "no-bindist"]
|
||||
then [color Red "no-bindist"]
|
||||
else mempty
|
||||
)
|
||||
]
|
||||
@ -1571,16 +1586,6 @@ printListResult raw lr = do
|
||||
|
||||
forM_ padded $ \row -> putStrLn $ intercalate " " row
|
||||
where
|
||||
printTag Recommended = color' Green "recommended"
|
||||
printTag Latest = color' Yellow "latest"
|
||||
printTag Prerelease = color' Red "prerelease"
|
||||
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||
printTag (UnknownTag t ) = t
|
||||
printTag Old = ""
|
||||
|
||||
color' = case raw of
|
||||
True -> flip const
|
||||
False -> color
|
||||
|
||||
padTo str' x =
|
||||
let lstr = strWidth str'
|
||||
|
||||
Loading…
Reference in New Issue
Block a user