From 657fc1551f103ef74d0d66dca9b5b9a557ee373d Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 1 Nov 2024 09:17:26 -1000 Subject: [PATCH] !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. --- hledger-lib/Hledger/Utils/IO.hs | 85 ++++++++++++++++++++++----------- hledger-lib/package.yaml | 1 - hledger/Hledger/Cli/Commands.hs | 2 +- 3 files changed, 58 insertions(+), 30 deletions(-) diff --git a/hledger-lib/Hledger/Utils/IO.hs b/hledger-lib/Hledger/Utils/IO.hs index e31a2c6f8..dfb8124ec 100644 --- a/hledger-lib/Hledger/Utils/IO.hs +++ b/hledger-lib/Hledger/Utils/IO.hs @@ -107,6 +107,7 @@ import Control.Monad (when, forM, guard, void) import Data.Char (toLower) import Data.Colour.RGBSpace (RGB(RGB)) import Data.Colour.RGBSpace.HSL (lightness) +import Data.Colour.SRGB (sRGB) import Data.FileEmbed (makeRelativeToProject, embedStringFile) import Data.Functor ((<&>)) 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 Data.Time.Clock (getCurrentTime) 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 GHC.IO.Exception (IOException(..), IOErrorType (ResourceVanished)) import Language.Haskell.TH.Syntax (Q, Exp) import Safe (headMay, maximumDef) -import String.ANSI -import System.Console.ANSI (Color(..),ColorIntensity(..), ConsoleLayer(..), SGR(..), hSupportsANSIColor, setSGRCode, getLayerColor) +import System.Console.ANSI (Color(..),ColorIntensity(..), ConsoleLayer(..), SGR(..), hSupportsANSIColor, setSGRCode, getLayerColor, ConsoleIntensity (..)) import System.Console.Terminal.Size (Window (Window), size) import System.Directory (getHomeDirectory, getModificationTime, findExecutable) import System.Environment (getArgs, lookupEnv, setEnv) @@ -386,68 +386,97 @@ hasOutputFile = do _ -> True -- 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 --- to not print junk onscreen. These use our useColorOnStdoutUnsafe. +-- Detect whether ANSI should be used on stdout using 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' = ifAnsi bold +bold' = ansiWrap sgrbold sgrnormal faint' :: String -> String -faint' = ifAnsi faint +faint' = ansiWrap sgrfaint sgrnormal black' :: String -> String -black' = ifAnsi black +black' = ansiWrap sgrblack sgrresetfg red' :: String -> String -red' = ifAnsi red +red' = ansiWrap sgrred sgrresetfg green' :: String -> String -green' = ifAnsi green +green' = ansiWrap sgrgreen sgrresetfg yellow' :: String -> String -yellow' = ifAnsi yellow +yellow' = ansiWrap sgryellow sgrresetfg blue' :: String -> String -blue' = ifAnsi blue +blue' = ansiWrap sgrblue sgrresetfg magenta' :: String -> String -magenta' = ifAnsi magenta +magenta' = ansiWrap sgrmagenta sgrresetfg cyan' :: String -> String -cyan' = ifAnsi cyan +cyan' = ansiWrap sgrcyan sgrresetfg white' :: String -> String -white' = ifAnsi white +white' = ansiWrap sgrwhite sgrresetfg brightBlack' :: String -> String -brightBlack' = ifAnsi brightBlack +brightBlack' = ansiWrap sgrbrightblack sgrresetfg brightRed' :: String -> String -brightRed' = ifAnsi brightRed +brightRed' = ansiWrap sgrbrightred sgrresetfg brightGreen' :: String -> String -brightGreen' = ifAnsi brightGreen +brightGreen' = ansiWrap sgrbrightgreen sgrresetfg brightYellow' :: String -> String -brightYellow' = ifAnsi brightYellow +brightYellow' = ansiWrap sgrbrightyellow sgrresetfg brightBlue' :: String -> String -brightBlue' = ifAnsi brightBlue +brightBlue' = ansiWrap sgrbrightblue sgrresetfg brightMagenta' :: String -> String -brightMagenta' = ifAnsi brightMagenta +brightMagenta' = ansiWrap sgrbrightmagenta sgrresetfg brightCyan' :: String -> String -brightCyan' = ifAnsi brightCyan +brightCyan' = ansiWrap sgrbrightcyan sgrresetfg brightWhite' :: String -> String -brightWhite' = ifAnsi brightWhite +brightWhite' = ansiWrap sgrbrightwhite sgrresetfg -rgb' :: Word8 -> Word8 -> Word8 -> String -> String -rgb' r g b = ifAnsi (rgb r g b) +rgb' :: Float -> Float -> Float -> String -> String +rgb' r g b = ansiWrap (sgrrgb r g b) sgrresetfg -- | Should ANSI color & styling be used for standard output ? -- Considers useColorOnHandle stdout and whether there's an --output-file. diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index a96d37347..60226e7c8 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -78,7 +78,6 @@ dependencies: - template-haskell - terminal-size >=0.3.3 - text >=1.2.4.1 -- text-ansi >=0.2.1 - time >=1.5 - timeit - transformers >=0.2 diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index 56295085a..f7318223a 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -328,7 +328,7 @@ printCommandsList progversion installedaddons = seq (length $ dbg8 "installedknownaddons" installedknownaddons) $ seq (length $ dbg8 "installedunknownaddons" installedunknownaddons) $ runPager $ unlines $ map unplus $ filter (not.isuninstalledaddon) $ - commandsList progversion installedunknownaddons + commandsList progversion installedunknownaddons where knownaddons = knownAddonCommands uninstalledknownaddons = knownaddons \\ installedaddons