slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib:Hledger.Utils.IO: add warnIO

Browse Source
This commit is contained in:
Simon Michael 2025-08-26 16:57:32 +01:00
parent cffee7f546
commit c7878e88da
1 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
hledger-lib/Hledger/Utils/IO.hs
View File

@ -23,6 +23,7 @@ module Hledger.Utils.IO (
error', error',
usageError, usageError,
warn, warn,
warnIO,
ansiFormatError, ansiFormatError,
ansiFormatWarning, ansiFormatWarning,
printError, printError,
@ -160,6 +161,7 @@ import System.Process (CreateProcess(..), StdStream(CreatePipe), creat
import Text.Pretty.Simple (CheckColorTty(..), OutputOptions(..), defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt) import Text.Pretty.Simple (CheckColorTty(..), OutputOptions(..), defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt)
import Hledger.Utils.Text (WideBuilder(WideBuilder)) import Hledger.Utils.Text (WideBuilder(WideBuilder))
import Control.Monad.IO.Class (MonadIO, liftIO)
-- Pretty showing/printing -- Pretty showing/printing
@ -217,17 +219,20 @@ usageError = error' . (++ " (use -h to see usage)")
ansiFormatError :: String -> String ansiFormatError :: String -> String
ansiFormatError = (<> sgrresetall) . ((sgrbrightred <> sgrbold) <>) ansiFormatError = (<> sgrresetall) . ((sgrbrightred <> sgrbold) <>)
-- | Show a message, with "Warning:" label, on stderr before returning the given value. -- | Show a warning message on stderr before returning the given value.
-- Also do some ANSI styling of the first line when allowed (using unsafe IO). -- Like trace, but prepends a "Warning:" label, and does some ANSI styling of the first line when allowed (using unsafe IO).
-- Currently we use this very sparingly in hledger; we prefer to either quietly work, -- Currently we use this very sparingly in hledger; we prefer to either quietly work, or loudly raise an error.
-- or loudly raise an error. Varying output can make scripting harder, -- Varying output can make scripting harder. But on stderr, it shouldn't cause much hassle.
-- but on stderr, it shouldn't cause much hassle.
warn :: String -> a -> a warn :: String -> a -> a
warn msg = trace msg' warn = trace . formatWarning
where
msg' = -- | Like warn, but take extra care to sequence properly in IO.
(if useColorOnStderrUnsafe then modifyFirstLine ansiFormatWarning else id) $ warnIO :: MonadIO m => String -> m ()
"Warning: "<> msg warnIO = liftIO . traceIO . formatWarning
formatWarning =
(if useColorOnStderrUnsafe then modifyFirstLine ansiFormatWarning else id) .
("Warning: " <>)
-- | Apply standard ANSI SGR formatting (yellow, bold) suitable for console warning text. -- | Apply standard ANSI SGR formatting (yellow, bold) suitable for console warning text.
ansiFormatWarning :: String -> String ansiFormatWarning :: String -> String