!fix: respect --color=yes in a few places that didn't; drop text-ansi dep
Hledger.Utils.IO's ansi style/color helpers now respect --color=yes, so that eg `hledger --color=yes | less -R` shows bold headings as you'd expect. Hledger.Utils.IO.rgb' now takes Float arguments instead of Word8.
This commit is contained in:
parent
66953ae0be
commit
657fc1551f
@ -107,6 +107,7 @@ import Control.Monad (when, forM, guard, void)
|
|||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
import Data.Colour.RGBSpace (RGB(RGB))
|
import Data.Colour.RGBSpace (RGB(RGB))
|
||||||
import Data.Colour.RGBSpace.HSL (lightness)
|
import Data.Colour.RGBSpace.HSL (lightness)
|
||||||
|
import Data.Colour.SRGB (sRGB)
|
||||||
import Data.FileEmbed (makeRelativeToProject, embedStringFile)
|
import Data.FileEmbed (makeRelativeToProject, embedStringFile)
|
||||||
import Data.Functor ((<&>))
|
import Data.Functor ((<&>))
|
||||||
import Data.List hiding (uncons)
|
import Data.List hiding (uncons)
|
||||||
@ -118,13 +119,12 @@ import qualified Data.Text.Lazy as TL
|
|||||||
import qualified Data.Text.Lazy.Builder as TB
|
import qualified Data.Text.Lazy.Builder as TB
|
||||||
import Data.Time.Clock (getCurrentTime)
|
import Data.Time.Clock (getCurrentTime)
|
||||||
import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone, utcToLocalTime, utcToZonedTime)
|
import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone, utcToLocalTime, utcToZonedTime)
|
||||||
import Data.Word (Word8, Word16)
|
import Data.Word (Word16)
|
||||||
import Foreign.C.Error (Errno(..), ePIPE)
|
import Foreign.C.Error (Errno(..), ePIPE)
|
||||||
import GHC.IO.Exception (IOException(..), IOErrorType (ResourceVanished))
|
import GHC.IO.Exception (IOException(..), IOErrorType (ResourceVanished))
|
||||||
import Language.Haskell.TH.Syntax (Q, Exp)
|
import Language.Haskell.TH.Syntax (Q, Exp)
|
||||||
import Safe (headMay, maximumDef)
|
import Safe (headMay, maximumDef)
|
||||||
import String.ANSI
|
import System.Console.ANSI (Color(..),ColorIntensity(..), ConsoleLayer(..), SGR(..), hSupportsANSIColor, setSGRCode, getLayerColor, ConsoleIntensity (..))
|
||||||
import System.Console.ANSI (Color(..),ColorIntensity(..), ConsoleLayer(..), SGR(..), hSupportsANSIColor, setSGRCode, getLayerColor)
|
|
||||||
import System.Console.Terminal.Size (Window (Window), size)
|
import System.Console.Terminal.Size (Window (Window), size)
|
||||||
import System.Directory (getHomeDirectory, getModificationTime, findExecutable)
|
import System.Directory (getHomeDirectory, getModificationTime, findExecutable)
|
||||||
import System.Environment (getArgs, lookupEnv, setEnv)
|
import System.Environment (getArgs, lookupEnv, setEnv)
|
||||||
@ -386,68 +386,97 @@ hasOutputFile = do
|
|||||||
_ -> True
|
_ -> True
|
||||||
|
|
||||||
-- ANSI colour
|
-- ANSI colour
|
||||||
-- XXX unsafe detection of --color option. At the moment this is always true in ghci,
|
|
||||||
-- respects the command line --color if compiled, and ignores the config file.
|
|
||||||
ifAnsi f = if useColorOnStdoutUnsafe then f else id
|
|
||||||
|
|
||||||
-- | Versions of some of text-ansi's string colors/styles which are more careful
|
-- Detect whether ANSI should be used on stdout using useColorOnStdoutUnsafe,
|
||||||
-- to not print junk onscreen. These use our useColorOnStdoutUnsafe.
|
-- and if so prepend and append the given SGR codes to a string.
|
||||||
|
-- Currently used in a few places (eg: the commands list, the demo command, the recentassertions error message.)
|
||||||
|
-- This tends to get stuck on or off in GHCI,
|
||||||
|
-- respects the command line --color if compiled,
|
||||||
|
-- and ignores the config file.
|
||||||
|
ansiWrap :: SGRString -> SGRString -> String -> String
|
||||||
|
ansiWrap pre post s = if useColorOnStdoutUnsafe then pre<>s<>post else s
|
||||||
|
|
||||||
|
type SGRString = String
|
||||||
|
|
||||||
|
sgrbold = setSGRCode [SetConsoleIntensity BoldIntensity]
|
||||||
|
sgrfaint = setSGRCode [SetConsoleIntensity FaintIntensity]
|
||||||
|
sgrnormal = setSGRCode [SetConsoleIntensity NormalIntensity]
|
||||||
|
sgrresetfg = setSGRCode [SetDefaultColor Foreground]
|
||||||
|
sgrblack = setSGRCode [SetColor Foreground Dull Black]
|
||||||
|
sgrred = setSGRCode [SetColor Foreground Dull Red]
|
||||||
|
sgrgreen = setSGRCode [SetColor Foreground Dull Green]
|
||||||
|
sgryellow = setSGRCode [SetColor Foreground Dull Yellow]
|
||||||
|
sgrblue = setSGRCode [SetColor Foreground Dull Blue]
|
||||||
|
sgrmagenta = setSGRCode [SetColor Foreground Dull Magenta]
|
||||||
|
sgrcyan = setSGRCode [SetColor Foreground Dull Cyan]
|
||||||
|
sgrwhite = setSGRCode [SetColor Foreground Dull White]
|
||||||
|
sgrbrightblack = setSGRCode [SetColor Foreground Vivid Black]
|
||||||
|
sgrbrightred = setSGRCode [SetColor Foreground Vivid Red]
|
||||||
|
sgrbrightgreen = setSGRCode [SetColor Foreground Vivid Green]
|
||||||
|
sgrbrightyellow = setSGRCode [SetColor Foreground Vivid Yellow]
|
||||||
|
sgrbrightblue = setSGRCode [SetColor Foreground Vivid Blue]
|
||||||
|
sgrbrightmagenta = setSGRCode [SetColor Foreground Vivid Magenta]
|
||||||
|
sgrbrightcyan = setSGRCode [SetColor Foreground Vivid Cyan]
|
||||||
|
sgrbrightwhite = setSGRCode [SetColor Foreground Vivid White]
|
||||||
|
sgrrgb r g b = setSGRCode [SetRGBColor Foreground $ sRGB r g b]
|
||||||
|
|
||||||
|
-- | Set various ANSI styles/colours in a string, only if useColorOnStdoutUnsafe says we should.
|
||||||
bold' :: String -> String
|
bold' :: String -> String
|
||||||
bold' = ifAnsi bold
|
bold' = ansiWrap sgrbold sgrnormal
|
||||||
|
|
||||||
faint' :: String -> String
|
faint' :: String -> String
|
||||||
faint' = ifAnsi faint
|
faint' = ansiWrap sgrfaint sgrnormal
|
||||||
|
|
||||||
black' :: String -> String
|
black' :: String -> String
|
||||||
black' = ifAnsi black
|
black' = ansiWrap sgrblack sgrresetfg
|
||||||
|
|
||||||
red' :: String -> String
|
red' :: String -> String
|
||||||
red' = ifAnsi red
|
red' = ansiWrap sgrred sgrresetfg
|
||||||
|
|
||||||
green' :: String -> String
|
green' :: String -> String
|
||||||
green' = ifAnsi green
|
green' = ansiWrap sgrgreen sgrresetfg
|
||||||
|
|
||||||
yellow' :: String -> String
|
yellow' :: String -> String
|
||||||
yellow' = ifAnsi yellow
|
yellow' = ansiWrap sgryellow sgrresetfg
|
||||||
|
|
||||||
blue' :: String -> String
|
blue' :: String -> String
|
||||||
blue' = ifAnsi blue
|
blue' = ansiWrap sgrblue sgrresetfg
|
||||||
|
|
||||||
magenta' :: String -> String
|
magenta' :: String -> String
|
||||||
magenta' = ifAnsi magenta
|
magenta' = ansiWrap sgrmagenta sgrresetfg
|
||||||
|
|
||||||
cyan' :: String -> String
|
cyan' :: String -> String
|
||||||
cyan' = ifAnsi cyan
|
cyan' = ansiWrap sgrcyan sgrresetfg
|
||||||
|
|
||||||
white' :: String -> String
|
white' :: String -> String
|
||||||
white' = ifAnsi white
|
white' = ansiWrap sgrwhite sgrresetfg
|
||||||
|
|
||||||
brightBlack' :: String -> String
|
brightBlack' :: String -> String
|
||||||
brightBlack' = ifAnsi brightBlack
|
brightBlack' = ansiWrap sgrbrightblack sgrresetfg
|
||||||
|
|
||||||
brightRed' :: String -> String
|
brightRed' :: String -> String
|
||||||
brightRed' = ifAnsi brightRed
|
brightRed' = ansiWrap sgrbrightred sgrresetfg
|
||||||
|
|
||||||
brightGreen' :: String -> String
|
brightGreen' :: String -> String
|
||||||
brightGreen' = ifAnsi brightGreen
|
brightGreen' = ansiWrap sgrbrightgreen sgrresetfg
|
||||||
|
|
||||||
brightYellow' :: String -> String
|
brightYellow' :: String -> String
|
||||||
brightYellow' = ifAnsi brightYellow
|
brightYellow' = ansiWrap sgrbrightyellow sgrresetfg
|
||||||
|
|
||||||
brightBlue' :: String -> String
|
brightBlue' :: String -> String
|
||||||
brightBlue' = ifAnsi brightBlue
|
brightBlue' = ansiWrap sgrbrightblue sgrresetfg
|
||||||
|
|
||||||
brightMagenta' :: String -> String
|
brightMagenta' :: String -> String
|
||||||
brightMagenta' = ifAnsi brightMagenta
|
brightMagenta' = ansiWrap sgrbrightmagenta sgrresetfg
|
||||||
|
|
||||||
brightCyan' :: String -> String
|
brightCyan' :: String -> String
|
||||||
brightCyan' = ifAnsi brightCyan
|
brightCyan' = ansiWrap sgrbrightcyan sgrresetfg
|
||||||
|
|
||||||
brightWhite' :: String -> String
|
brightWhite' :: String -> String
|
||||||
brightWhite' = ifAnsi brightWhite
|
brightWhite' = ansiWrap sgrbrightwhite sgrresetfg
|
||||||
|
|
||||||
rgb' :: Word8 -> Word8 -> Word8 -> String -> String
|
rgb' :: Float -> Float -> Float -> String -> String
|
||||||
rgb' r g b = ifAnsi (rgb r g b)
|
rgb' r g b = ansiWrap (sgrrgb r g b) sgrresetfg
|
||||||
|
|
||||||
-- | Should ANSI color & styling be used for standard output ?
|
-- | Should ANSI color & styling be used for standard output ?
|
||||||
-- Considers useColorOnHandle stdout and whether there's an --output-file.
|
-- Considers useColorOnHandle stdout and whether there's an --output-file.
|
||||||
|
|||||||
@ -78,7 +78,6 @@ dependencies:
|
|||||||
- template-haskell
|
- template-haskell
|
||||||
- terminal-size >=0.3.3
|
- terminal-size >=0.3.3
|
||||||
- text >=1.2.4.1
|
- text >=1.2.4.1
|
||||||
- text-ansi >=0.2.1
|
|
||||||
- time >=1.5
|
- time >=1.5
|
||||||
- timeit
|
- timeit
|
||||||
- transformers >=0.2
|
- transformers >=0.2
|
||||||
|
|||||||
@ -328,7 +328,7 @@ printCommandsList progversion installedaddons =
|
|||||||
seq (length $ dbg8 "installedknownaddons" installedknownaddons) $
|
seq (length $ dbg8 "installedknownaddons" installedknownaddons) $
|
||||||
seq (length $ dbg8 "installedunknownaddons" installedunknownaddons) $
|
seq (length $ dbg8 "installedunknownaddons" installedunknownaddons) $
|
||||||
runPager $ unlines $ map unplus $ filter (not.isuninstalledaddon) $
|
runPager $ unlines $ map unplus $ filter (not.isuninstalledaddon) $
|
||||||
commandsList progversion installedunknownaddons
|
commandsList progversion installedunknownaddons
|
||||||
where
|
where
|
||||||
knownaddons = knownAddonCommands
|
knownaddons = knownAddonCommands
|
||||||
uninstalledknownaddons = knownaddons \\ installedaddons
|
uninstalledknownaddons = knownaddons \\ installedaddons
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user