    {- |
    General and hledger-specific input/output-related helpers for
    pretty-printing haskell values, error reporting, time, files, command line parsing,
    terminals, pager output, ANSI colour/styles, etc.
    -}

    {-# LANGUAGE ImplicitParams      #-}
    {-# LANGUAGE LambdaCase          #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE PackageImports      #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE MultiWayIf #-}

    module Hledger.Utils.IO (

      -- * Pretty showing/printing
      pshow,
      pshow',
      pprint,
      pprint',

      -- * Errors
      error',
      usageError,
      warn,
      warnIO,
      ansiFormatError,
      ansiFormatWarning,
      printError,
      exitWithErrorMessage,
      handleExit,

      -- * Time
      getCurrentLocalTime,
      getCurrentZonedTime,

      -- * Files
      getHomeSafe,
      embedFileRelative,
      expandHomePath,
      expandPath,
      expandGlob,
      sortByModTime,
      openFileOrStdin,
      readFileOrStdinPortably,
      readFileOrStdinPortably',
      readFileStrictly,
      readFilePortably,
      readHandlePortably,
      readHandlePortably',
      -- hereFileRelative,
      inputToHandle,

      -- * Command line parsing
      progArgs,
      getFlag,
      getOpt,
      parseYN,
      parseYNA,
      YNA(..),
      -- hasOutputFile,
      -- outputFileOption,

      -- * Terminal size
      getTerminalHeightWidth,
      getTerminalHeight,
      getTerminalWidth,

      -- * Pager output
      setupPager,
      findPager,
      runPager,

      -- * ANSI colour/styles

      -- ** hledger-specific

      colorOption,
      useColorOnStdout,
      useColorOnStderr,
      useColorOnStdoutUnsafe,
      useColorOnStderrUnsafe,
      bold',
      faint',
      black',
      red',
      green',
      yellow',
      blue',
      magenta',
      cyan',
      white',
      brightBlack',
      brightRed',
      brightGreen',
      brightYellow',
      brightBlue',
      brightMagenta',
      brightCyan',
      brightWhite',
      rgb',
      sgrresetall,

      -- ** Generic

      color,
      bgColor,
      colorB,
      bgColorB,
      -- XXX Types used with color/bgColor/colorB/bgColorB,
      -- not re-exported because clashing with UIUtils:
      -- Color(..),
      -- ColorIntensity(..),

      terminalIsLight,
      terminalLightness,
      terminalFgColor,
      terminalBgColor,

      )
    where

    import           Control.Concurrent (forkIO)
    import           Control.Exception
    import           Control.Monad (when, forM, guard, void)
    import           Data.Char (toLower, isSpace)
    import           Data.Colour.RGBSpace (RGB(RGB))
    import           Data.Colour.RGBSpace.HSL (lightness)
    import           Data.Colour.SRGB (sRGB)
    import           Data.Encoding (DynEncoding)
    import           Data.FileEmbed (makeRelativeToProject, embedStringFile)
    import           Data.Functor ((<&>))
    import           Data.List hiding (uncons)
    import           Data.Maybe (isJust, catMaybes)
    import Data.Text qualified as T
    import           Data.Text.Encoding.Error (UnicodeException)
    import Data.Text.IO qualified as T
    import Data.Text.Lazy qualified as TL
    import Data.Text.Lazy.Builder qualified as TB
    import           Data.Time.Clock (getCurrentTime)
    import           Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone, utcToLocalTime, utcToZonedTime)
    import           Data.Word (Word16)
    import           Debug.Trace
    import           Foreign.C.Error (Errno(..), ePIPE)
    import           GHC.IO.Encoding (getLocaleEncoding, textEncodingName)
    import           GHC.IO.Exception (IOException(..), IOErrorType (ResourceVanished))
    import           Language.Haskell.TH.Syntax (Q, Exp)
    import           Safe (headMay, maximumDef)
    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, getProgName)
    import           System.Exit (exitFailure)
    import           System.FilePath (isRelative, (</>))
    import "Glob"    System.FilePath.Glob (glob)
    import           System.Info (os)
    import           System.IO (Handle, IOMode (..), hClose, hGetEncoding, hIsTerminalDevice, hPutStr, hPutStrLn, hSetNewlineMode, hSetEncoding, openFile, stderr, stdin, stdout, universalNewlineMode, utf8_bom)
    import System.IO.Encoding qualified as Enc
    import           System.IO.Unsafe (unsafePerformIO)
    import           System.Process (CreateProcess(..), StdStream(CreatePipe), createPipe, shell, waitForProcess, withCreateProcess)
    import           Text.Pretty.Simple (CheckColorTty(..), OutputOptions(..), defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt)

    import Hledger.Utils.Text (WideBuilder(WideBuilder))
    import Control.Monad.IO.Class (MonadIO, liftIO)

    -- Pretty showing/printing
    -- using pretty-simple

    -- https://hackage.haskell.org/package/pretty-simple/docs/Text-Pretty-Simple.html#t:OutputOptions

    -- | pretty-simple options with colour enabled if allowed.
    prettyopts :: OutputOptions
    prettyopts =
      (if Bool
    useColorOnStderrUnsafe then OutputOptions
    defaultOutputOptionsDarkBg else OutputOptions
    defaultOutputOptionsNoColor)
        { outputOptionsIndentAmount = 2
        -- , outputOptionsCompact      = True  -- fills lines, but does not respect page width (https://github.com/cdepillabout/pretty-simple/issues/126)
        -- , outputOptionsPageWidth    = fromMaybe 80 $ unsafePerformIO getTerminalWidth
        }

    -- | pretty-simple options with colour disabled.
    prettyoptsNoColor :: OutputOptions
    prettyoptsNoColor =
      OutputOptions
    defaultOutputOptionsNoColor
        { outputOptionsIndentAmount=2
        }

    -- | Pretty show. An easier alias for pretty-simple's pShow.
    -- This will probably show in colour if useColorOnStderrUnsafe is true.
    pshow :: Show a => a -> String
    pshow :: forall a. Show a => a -> [Char]
    pshow = Text -> [Char]
    TL.unpack (Text -> [Char]) -> (a -> Text) -> a -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OutputOptions -> a -> Text
    forall a. Show a => OutputOptions -> a -> Text
    pShowOpt OutputOptions
    prettyopts

    -- | Monochrome version of pshow. This will never show in colour.
    pshow' :: Show a => a -> String
    pshow' :: forall a. Show a => a -> [Char]
    pshow' = Text -> [Char]
    TL.unpack (Text -> [Char]) -> (a -> Text) -> a -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OutputOptions -> a -> Text
    forall a. Show a => OutputOptions -> a -> Text
    pShowOpt OutputOptions
    prettyoptsNoColor

    -- | Pretty print a showable value. An easier alias for pretty-simple's pPrint.
    -- This will print in colour if useColorOnStderrUnsafe is true.
    pprint :: Show a => a -> IO ()
    pprint :: forall a. Show a => a -> IO ()
    pprint = CheckColorTty -> OutputOptions -> a -> IO ()
    forall (m :: * -> *) a.
    (MonadIO m, Show a) =>
    CheckColorTty -> OutputOptions -> a -> m ()
    pPrintOpt (if Bool
    useColorOnStderrUnsafe then CheckColorTty
    CheckColorTty else CheckColorTty
    NoCheckColorTty) OutputOptions
    prettyopts

    -- | Monochrome version of pprint. This will never print in colour.
    pprint' :: Show a => a -> IO ()
    pprint' :: forall a. Show a => a -> IO ()
    pprint' = CheckColorTty -> OutputOptions -> a -> IO ()
    forall (m :: * -> *) a.
    (MonadIO m, Show a) =>
    CheckColorTty -> OutputOptions -> a -> m ()
    pPrintOpt CheckColorTty
    NoCheckColorTty OutputOptions
    prettyoptsNoColor

    -- "Avoid using pshow, pprint, dbg* in the code below to prevent infinite loops." (?)

    -- Errors

    -- | Call errorWithoutStackTrace, prepending a "Error:" label.
    error' :: String -> a
    error' :: forall a. [Char] -> a
    error' = [Char] -> a
    forall a. [Char] -> a
    errorWithoutStackTrace ([Char] -> a) -> ([Char] -> [Char]) -> [Char] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char]
    "Error: "[Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | Like error', but add a hint about using -h.
    usageError :: String -> a
    usageError :: forall a. [Char] -> a
    usageError = [Char] -> a
    forall a. [Char] -> a
    error' ([Char] -> a) -> ([Char] -> [Char]) -> [Char] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " (use -h to see usage)")

    -- | Apply standard ANSI SGR formatting (red, bold) suitable for console error text.
    ansiFormatError :: String -> String
    ansiFormatError :: [Char] -> [Char]
    ansiFormatError = ([Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    sgrresetall) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Char]
    sgrbrightred [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    sgrbold) [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | Show a warning message on stderr before returning the given value.
    -- 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, or loudly raise an error.
    -- Varying output can make scripting harder. But on stderr, it shouldn't cause much hassle.
    warn :: String -> a -> a
    warn :: forall a. [Char] -> a -> a
    warn = [Char] -> a -> a
    forall a. [Char] -> a -> a
    trace ([Char] -> a -> a) -> ([Char] -> [Char]) -> [Char] -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    formatWarning

    -- | Like warn, but take extra care to sequence properly in IO.
    warnIO :: MonadIO m => String -> m ()
    warnIO :: forall (m :: * -> *). MonadIO m => [Char] -> m ()
    warnIO = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> ([Char] -> IO ()) -> [Char] -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> IO ()
    traceIO ([Char] -> IO ()) -> ([Char] -> [Char]) -> [Char] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    formatWarning

    formatWarning :: [Char] -> [Char]
    formatWarning =
      (if Bool
    useColorOnStderrUnsafe then ([Char] -> [Char]) -> [Char] -> [Char]
    modifyFirstLine [Char] -> [Char]
    ansiFormatWarning else [Char] -> [Char]
    forall a. a -> a
    id) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      ([Char]
    "Warning: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | Apply standard ANSI SGR formatting (yellow, bold) suitable for console warning text.
    ansiFormatWarning :: String -> String
    ansiFormatWarning :: [Char] -> [Char]
    ansiFormatWarning = ([Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    sgrresetall) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Char]
    sgrbrightyellow [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    sgrbold) [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>)

    -- Transform a string's first line.
    -- Note, this won't add a trailing newline if there isn't one,
    -- and it will remove one if there is one or more.
    modifyFirstLine :: (String -> String) -> String -> String
    modifyFirstLine :: ([Char] -> [Char]) -> [Char] -> [Char]
    modifyFirstLine [Char] -> [Char]
    f [Char]
    s = [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    "\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    f [[Char]]
    l [[Char]] -> [[Char]] -> [[Char]]
    forall a. Semigroup a => a -> a -> a
    <> [[Char]]
    ls where ([[Char]]
    l,[[Char]]
    ls) = Int -> [[Char]] -> ([[Char]], [[Char]])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    1 ([[Char]] -> ([[Char]], [[Char]]))
    -> [[Char]] -> ([[Char]], [[Char]])
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [[Char]]
    lines [Char]
    s  -- total

    -- | Print an error message to stderr, with a consistent "programname: " prefix,
    -- and applying ANSI styling (bold bright red) to the first line if that is supported and allowed.
    printError :: String -> IO ()
    printError :: [Char] -> IO ()
    printError [Char]
    msg = do
      progname <- IO [Char]
    getProgName
      usecolor <- useColorOnStderr
      let
        style = if Bool
    usecolor then ([Char] -> [Char]) -> [Char] -> [Char]
    modifyFirstLine [Char] -> [Char]
    ansiFormatError else [Char] -> [Char]
    forall a. a -> a
    id
        prefix =
          [Char]
    progname
            [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    ": "
            -- error' prepends an "Error: " prefix. But that seems to have been removed when I catch the ErrorCall exception - unless I'm running in GHCI.
            -- Is it possible something in GHC or base is removing it ?
            -- Use a stupid heuristic for now: add it again unless already there.
            [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> (if [Char]
    "Error:" [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    msg then [Char]
    "" else [Char]
    "Error: ")
      hPutStrLn stderr $ style $ prefix <> msg

    -- | Print an error message with printError,
    -- then exit the program with a non-zero exit code.
    exitWithErrorMessage :: String -> IO ()
    exitWithErrorMessage :: [Char] -> IO ()
    exitWithErrorMessage [Char]
    msg = [Char] -> IO ()
    printError [Char]
    msg IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    forall a. IO a
    exitFailure

    -- | This wraps a program's main routine so as to display more consistent,
    -- useful, and GHC-version-independent error output when the program exits
    -- because of certain common exceptions. It
    --
    -- 1. disables SIGPIPE errors, which are usually harmless,
    --    caused when our output is truncated in a piped command.
    --
    -- 2. catches these common exceptions:
    --
    --    - UnicodeException, caused eg by text decoding errors in pure code
    --
    --    - IOException, caused by I/O errors, including text decoding errors during I/O
    --
    --    - ErrorCall - @error@ / @errorWithoutStackTrace@ calls
    --
    -- 3. compensates for GHC output bugs:
    --
    --    - removes the trailing newlines added by some GHC 9.10.* versions
    --
    --    - removes "uncaught exception" output added by some GHC 9.12.* versions
    --
    --    - ensures a consistent "PROGNAME: " prefix
    --
    -- 4. applies bold bright red ANSI styling to the first line of error output,
    --    if that is supported and allowed
    --
    -- 5. for unicode exceptions and I/O exceptions which look like they were
    --    unicode-related, it adds a message (in english) explaining the problem and what to do.
    --
    -- Some exceptions this does not catch are ExitCode (exitSuccess/exitFailure/exitWith)
    -- and UserInterrupt (control-C).
    --
    handleExit :: IO () -> IO ()
    handleExit :: IO () -> IO ()
    handleExit = (IO () -> [Handler ()] -> IO ()) -> [Handler ()] -> IO () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip IO () -> [Handler ()] -> IO ()
    forall a. IO a -> [Handler a] -> IO a
    catches [
       -- Handler (\(e::SomeException) -> error' $ pshow e),  -- debug
       (UnicodeException -> IO ()) -> Handler ()
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler (\(UnicodeException
    e::UnicodeException) -> UnicodeException -> IO ()
    forall e. Exception e => e -> IO ()
    exitUnicode UnicodeException
    e)
      ,(IOException -> IO ()) -> Handler ()
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler (\(IOException
    e::IOException) -> if
        | IOException -> Bool
    forall e. Exception e => e -> Bool
    isUnicodeError IOException
    e    -> IOException -> IO ()
    forall e. Exception e => e -> IO ()
    exitUnicode IOException
    e
        | Bool
    otherwise           -> IOException -> IO ()
    forall e. Exception e => e -> IO ()
    exitOther IOException
    e)
      ,(ErrorCall -> IO ()) -> Handler ()
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler (\(ErrorCall
    e::ErrorCall) -> ErrorCall -> IO ()
    forall e. Exception e => e -> IO ()
    exitOther ErrorCall
    e)
      ] (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> IO ()
    ignoreSigPipe

      where
        -- | Ignore SIGPIPE errors.
        -- This is copied from System.Process.Internals in process 1.6.20.0+,
        -- since that version of process comes only with ghc 9.10.2+.
        ignoreSigPipe :: IO () -> IO ()
        ignoreSigPipe :: IO () -> IO ()
    ignoreSigPipe = (IOException -> IO ()) -> IO () -> IO ()
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle ((IOException -> IO ()) -> IO () -> IO ())
    -> (IOException -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IOException
    e -> case IOException
    e of
          IOError { ioe_type :: IOException -> IOErrorType
    ioe_type  = IOErrorType
    ResourceVanished
                  , ioe_errno :: IOException -> Maybe CInt
    ioe_errno = Just CInt
    ioe }
            | CInt -> Errno
    Errno CInt
    ioe Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    ePIPE -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          IOException
    _ -> IOException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO IOException
    e

        -- Many decoding failures do not produce a UnicodeException, unfortunately.
        -- So this fragile hack detects them from the error message.
        -- But there are many variant wordings and they probably change over time.
        -- It's not ideal.
        isUnicodeError :: Exception e => e -> Bool
        isUnicodeError :: forall e. Exception e => e -> Bool
    isUnicodeError e
    ex =
          let msg :: [Char]
    msg = (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (e -> [Char]
    forall a. Show a => a -> [Char]
    show e
    ex) in ([Char] -> Bool) -> [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` [Char]
    msg) [
              [Char]
    "illegal byte sequence"
            , [Char]
    "invalid byte sequence"
            , [Char]
    "cannot decode byte sequence"
            , [Char]
    "invalid character"
            , [Char]
    "invalid or incomplete multibyte"
            , [Char]
    "mkTextEncoding: invalid argument"
            ]

        exitUnicode :: Exception e => e -> IO ()
        exitUnicode :: forall e. Exception e => e -> IO ()
    exitUnicode e
    ex = do
          enc <- IO [Char]
    getSystemEncoding
          let
            noencoding = (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    enc [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "ascii"
            msg = [[Char]] -> [Char]
    unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [
                [Char] -> [Char]
    rstrip ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ e -> [Char]
    forall a. Show a => a -> [Char]
    show e
    ex
              , [Char]
    "Some text could not be decoded with the system's text encoding, " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    enc
              , [Char]
    "(or, the text encoding specified by CSV rules)."
              ] [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++
              if Bool
    noencoding
              then [
                [Char]
    "Please configure a system locale which can decode this text."
              ]
              else [
                [Char]
    "Please either convert the text to this encoding,"
              , [Char]
    "or configure a system locale which can decode this text."
              ]
          exitWithErrorMessage msg

        exitOther :: Exception e => e -> IO ()
        exitOther :: forall e. Exception e => e -> IO ()
    exitOther = [Char] -> IO ()
    exitWithErrorMessage ([Char] -> IO ()) -> (e -> [Char]) -> e -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    rstrip ([Char] -> [Char]) -> (e -> [Char]) -> e -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> [Char]
    forall a. Show a => a -> [Char]
    show

        rstrip :: [Char] -> [Char]
    rstrip = [Char] -> [Char]
    forall a. [a] -> [a]
    reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    forall a. [a] -> [a]
    reverse

    -- I18n

    -- encoding has a similar getSystemEncoding :: IO (Maybe DynEncoding)
    -- but it returns Nothing on Windows or if there's an error.

    -- | Get the name of the text encoding used by the current locale, using GHC's API.
    getSystemEncoding :: IO String
    getSystemEncoding :: IO [Char]
    getSystemEncoding = do
      localeEncoding <- IO TextEncoding
    getLocaleEncoding
      return $ textEncodingName localeEncoding

    -- -- | Get the name of the text encoding currently configured for stdout, using GHC's API.
    -- getStdoutEncoding :: IO (Maybe String)
    -- getStdoutEncoding = do
    --   mEncoding <- hGetEncoding stdout
    --   return $ fmap textEncodingName mEncoding

    -- Time

    getCurrentLocalTime :: IO LocalTime
    getCurrentLocalTime :: IO LocalTime
    getCurrentLocalTime = do
      t <- IO UTCTime
    getCurrentTime
      tz <- getCurrentTimeZone
      return $ utcToLocalTime tz t

    getCurrentZonedTime :: IO ZonedTime
    getCurrentZonedTime :: IO ZonedTime
    getCurrentZonedTime = do
      t <- IO UTCTime
    getCurrentTime
      tz <- getCurrentTimeZone
      return $ utcToZonedTime tz t

    -- Files

    -- | Like getHomeDirectory, but in case of IO error (home directory not found, not understood, etc.), returns "".
    getHomeSafe :: IO (Maybe FilePath)
    getHomeSafe :: IO (Maybe [Char])
    getHomeSafe = ([Char] -> Maybe [Char]) -> IO [Char] -> IO (Maybe [Char])
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just IO [Char]
    getHomeDirectory IO (Maybe [Char])
    -> (IOException -> IO (Maybe [Char])) -> IO (Maybe [Char])
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` (\(IOException
    _ :: IOException) -> Maybe [Char] -> IO (Maybe [Char])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Char]
    forall a. Maybe a
    Nothing)

    -- | Expand a tilde (representing home directory) at the start of a file path.
    -- ~username is not supported. Can raise an error.
    expandHomePath :: FilePath -> IO FilePath
    expandHomePath :: [Char] -> IO [Char]
    expandHomePath = \case
        (Char
    '~':Char
    '/':[Char]
    p)  -> ([Char] -> [Char] -> [Char]
    </> [Char]
    p) ([Char] -> [Char]) -> IO [Char] -> IO [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [Char]
    getHomeDirectory
        (Char
    '~':Char
    '\\':[Char]
    p) -> ([Char] -> [Char] -> [Char]
    </> [Char]
    p) ([Char] -> [Char]) -> IO [Char] -> IO [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [Char]
    getHomeDirectory
        (Char
    '~':[Char]
    _)      -> IOException -> IO [Char]
    forall a. IOException -> IO a
    ioError (IOException -> IO [Char]) -> IOException -> IO [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IOException
    userError [Char]
    "~USERNAME in paths is not supported"
        [Char]
    p            -> [Char] -> IO [Char]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    p

    -- | Given a current directory, convert a possibly relative, possibly tilde-prefixed
    -- file path to an absolute one.
    -- ~username is not supported. Leaves "-" unchanged. Can raise an error.
    expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in reader parsers
    expandPath :: [Char] -> [Char] -> IO [Char]
    expandPath [Char]
    _ [Char]
    "-" = [Char] -> IO [Char]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    "-"
    expandPath [Char]
    curdir [Char]
    p = (if [Char] -> Bool
    isRelative [Char]
    p then ([Char]
    curdir [Char] -> [Char] -> [Char]
    </>) else [Char] -> [Char]
    forall a. a -> a
    id) ([Char] -> [Char]) -> IO [Char] -> IO [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO [Char]
    expandHomePath [Char]
    p  -- PARTIAL:

    -- | Like expandPath, but treats the expanded path as a glob, and returns
    -- zero or more matched absolute file paths, alphabetically sorted.
    -- Can raise an error.
    expandGlob :: FilePath -> FilePath -> IO [FilePath]
    expandGlob :: [Char] -> [Char] -> IO [[Char]]
    expandGlob [Char]
    curdir [Char]
    p = [Char] -> [Char] -> IO [Char]
    expandPath [Char]
    curdir [Char]
    p IO [Char] -> ([Char] -> IO [[Char]]) -> IO [[Char]]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Char] -> IO [[Char]]
    glob IO [[Char]] -> ([[Char]] -> [[Char]]) -> IO [[Char]]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> [[Char]] -> [[Char]]
    forall a. Ord a => [a] -> [a]
    sort  -- PARTIAL:

    -- | Given a list of existing file paths, sort them by modification time (from oldest to newest).
    sortByModTime :: [FilePath] -> IO [FilePath]
    sortByModTime :: [[Char]] -> IO [[Char]]
    sortByModTime [[Char]]
    fs = do
      ftimes <- [[Char]]
    -> ([Char] -> IO (UTCTime, [Char])) -> IO [(UTCTime, [Char])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [[Char]]
    fs (([Char] -> IO (UTCTime, [Char])) -> IO [(UTCTime, [Char])])
    -> ([Char] -> IO (UTCTime, [Char])) -> IO [(UTCTime, [Char])]
    forall a b. (a -> b) -> a -> b
    $ \[Char]
    f -> do {t <- [Char] -> IO UTCTime
    getModificationTime [Char]
    f; return (t,f)}
      return $ map snd $ sort ftimes

    -- | Like readFilePortably, but read all of the file before proceeding.
    readFileStrictly :: FilePath -> IO T.Text
    readFileStrictly :: [Char] -> IO Text
    readFileStrictly [Char]
    f = [Char] -> IO Text
    readFilePortably [Char]
    f IO Text -> (Text -> IO Text) -> IO Text
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Text
    t -> Int -> IO Int
    forall a. a -> IO a
    evaluate (Text -> Int
    T.length Text
    t) IO Int -> IO Text -> IO Text
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    t

    -- | Read text from a file,
    -- converting any \r\n line endings to \n,,
    -- using the system locale's text encoding,
    -- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8.
    readFilePortably :: FilePath -> IO T.Text
    readFilePortably :: [Char] -> IO Text
    readFilePortably [Char]
    f =  [Char] -> IOMode -> IO Handle
    openFile [Char]
    f IOMode
    ReadMode IO Handle -> (Handle -> IO Text) -> IO Text
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Handle -> IO Text
    readHandlePortably

    -- | Like readFilePortably, but read from standard input if the path is "-".
    readFileOrStdinPortably :: String -> IO T.Text
    readFileOrStdinPortably :: [Char] -> IO Text
    readFileOrStdinPortably = Maybe DynEncoding -> [Char] -> IO Text
    readFileOrStdinPortably' Maybe DynEncoding
    forall a. Maybe a
    Nothing

    -- | Like readFileOrStdinPortably, but take an optional converter.
    readFileOrStdinPortably' :: Maybe DynEncoding -> String -> IO T.Text
    readFileOrStdinPortably' :: Maybe DynEncoding -> [Char] -> IO Text
    readFileOrStdinPortably' Maybe DynEncoding
    c [Char]
    f = [Char] -> IO Handle
    openFileOrStdin [Char]
    f IO Handle -> (Handle -> IO Text) -> IO Text
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe DynEncoding -> Handle -> IO Text
    readHandlePortably' Maybe DynEncoding
    c

    -- | Open a file for reading, using the standard System.IO.openFile.
    -- This opens the handle in text mode, using the initial system locale's text encoding.
    openFileOrStdin :: String -> IO Handle
    openFileOrStdin :: [Char] -> IO Handle
    openFileOrStdin [Char]
    "-" = Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    stdin
    openFileOrStdin [Char]
    f' = [Char] -> IOMode -> IO Handle
    openFile [Char]
    f' IOMode
    ReadMode

    -- readHandlePortably' with no text encoding specified.
    readHandlePortably :: Handle -> IO T.Text
    readHandlePortably :: Handle -> IO Text
    readHandlePortably = Maybe DynEncoding -> Handle -> IO Text
    readHandlePortably' Maybe DynEncoding
    forall a. Maybe a
    Nothing

    -- | Read text from a handle with a specified encoding, using the encoding package.
    -- Or if no encoding is specified, it uses the handle's current encoding,
    -- after first changing it to UTF-8BOM if it was UTF-8, to allow a Byte Order Mark at the start.
    -- Also it converts Windows line endings to newlines.
    -- If decoding fails, this throws an IOException (or possibly a UnicodeException or something else from the encoding package).
    readHandlePortably' :: Maybe DynEncoding -> Handle -> IO T.Text
    readHandlePortably' :: Maybe DynEncoding -> Handle -> IO Text
    readHandlePortably' Maybe DynEncoding
    Nothing Handle
    h = do
      Handle -> NewlineMode -> IO ()
    hSetNewlineMode Handle
    h NewlineMode
    universalNewlineMode
      menc <- Handle -> IO (Maybe TextEncoding)
    hGetEncoding Handle
    h
      when (fmap show menc == Just "UTF-8") $ hSetEncoding h utf8_bom
      T.hGetContents h
    readHandlePortably' (Just DynEncoding
    e) Handle
    h =
      -- convert newlines manually, because Enc.hGetContents uses bytestring's hGetContents
      HasCallStack => Text -> Text -> Text -> Text
    Text -> Text -> Text -> Text
    T.replace Text
    "\r\n" Text
    "\n" (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Text
    T.pack ([Char] -> Text) -> IO [Char] -> IO Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> let ?enc = ?enc::DynEncoding
    DynEncoding
    e in Handle -> IO [Char]
    forall e. (Encoding e, ?enc::e) => Handle -> IO [Char]
    Enc.hGetContents Handle
    h

    -- | Create a handle from which the given text can be read.
    -- Its encoding will be UTF-8BOM.
    inputToHandle :: T.Text -> IO Handle
    inputToHandle :: Text -> IO Handle
    inputToHandle Text
    t = do
      (r, w) <- IO (Handle, Handle)
    createPipe
      hSetEncoding r utf8_bom
      hSetEncoding w utf8_bom
      -- use a separate thread so that we don't deadlock if we can't write all of the text at once
      forkIO $ T.hPutStr w t >> hClose w
      return r

    -- | Like embedFile, but takes a path relative to the package directory.
    embedFileRelative :: FilePath -> Q Exp
    embedFileRelative :: [Char] -> Q Exp
    embedFileRelative [Char]
    f = [Char] -> Q [Char]
    makeRelativeToProject [Char]
    f Q [Char] -> ([Char] -> Q Exp) -> Q Exp
    forall a b. Q a -> (a -> Q b) -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Char] -> Q Exp
    embedStringFile

    -- -- | Like hereFile, but takes a path relative to the package directory.
    -- -- Similar to embedFileRelative ?
    -- hereFileRelative :: FilePath -> Q Exp
    -- hereFileRelative f = makeRelativeToProject f >>= hereFileExp
    --   where
    --     QuasiQuoter{quoteExp=hereFileExp} = hereFile

    -- Command line parsing

    -- | The program's command line arguments.
    -- Uses unsafePerformIO; tends to stick in GHCI until reloaded,
    -- and may or may not detect args provided by a hledger config file.
    {-# NOINLINE progArgs #-}
    progArgs :: [String]
    progArgs :: [[Char]]
    progArgs = IO [[Char]] -> [[Char]]
    forall a. IO a -> a
    unsafePerformIO IO [[Char]]
    getArgs
    -- XX currently this affects:
    --  the enabling of orderdates and assertions checks in journalFinalise
    --  a few cases involving --color (see useColorOnStdoutUnsafe)
    --  --debug

    -- | Given one or more long or short flag names,
    -- report whether this flag is present in the command line.
    -- Concatenated short flags (-a -b written as -ab) are not supported.
    getFlag :: [String] -> IO Bool
    getFlag :: [[Char]] -> IO Bool
    getFlag [[Char]]
    names = do
      let flags :: [[Char]]
    flags = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    toFlag [[Char]]
    names
      args <- IO [[Char]]
    getArgs
      return $ any (`elem` args) flags

    -- | Given one or more long or short option names, read the rightmost value of this option from the command line arguments.
    -- If the value is missing raise an error.
    -- Concatenated short flags (-a -b written as -ab) are not supported.
    getOpt :: [String] -> IO (Maybe String)
    getOpt :: [[Char]] -> IO (Maybe [Char])
    getOpt [[Char]]
    names = do
      rargs <- [[Char]] -> [[Char]]
    forall a. [a] -> [a]
    reverse ([[Char]] -> [[Char]])
    -> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Char]] -> [[Char]]
    splitFlagsAndVals ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [[Char]]
    getArgs
      let flags = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    toFlag [[Char]]
    names
      return $
        case break ((`elem` flags)) rargs of
          ([[Char]]
    _,[])        -> Maybe [Char]
    forall a. Maybe a
    Nothing
          ([],[Char]
    flag:[[Char]]
    _)   -> [Char] -> Maybe [Char]
    forall a. [Char] -> a
    error' ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    flag [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    " requires a value"
          ([[Char]]
    argsafter,[[Char]]
    _) -> [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall a. HasCallStack => [a] -> a
    last [[Char]]
    argsafter

    -- | Given a list of command line arguments, split any of the form --flag=VAL or -fVAL into two list items.
    -- Concatenated short flags (-a -b written as -ab) are not supported.
    splitFlagsAndVals :: [String] -> [String]
    splitFlagsAndVals :: [[Char]] -> [[Char]]
    splitFlagsAndVals = ([Char] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (([Char] -> [[Char]]) -> [[Char]] -> [[Char]])
    -> ([Char] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $
      \case
        a :: [Char]
    a@(Char
    '-':Char
    '-':[Char]
    _) | Char
    '=' Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char]
    a -> let ([Char]
    x,[Char]
    y) = (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '=') [Char]
    a in [[Char]
    x, Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [Char]
    y]
        a :: [Char]
    a@(Char
    '-':Char
    f:Char
    _:[Char]
    _) | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Char
    fChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '-' -> [Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    take Int
    2 [Char]
    a, Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop Int
    2 [Char]
    a]
        [Char]
    a -> [[Char]
    a]

    -- | Convert a short or long flag name to a flag with leading hyphen(s).
    toFlag :: [Char] -> [Char]
    toFlag [Char
    c] = [Char
    '-',Char
    c]
    toFlag [Char]
    s   = Char
    '-'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :Char
    '-'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :[Char]
    s

    -- | Parse y/yes/always or n/no/never to true or false, or return an error message.
    parseYN :: String -> Either String Bool
    parseYN :: [Char] -> Either [Char] Bool
    parseYN [Char]
    s
      | [Char]
    l [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]
    "y",[Char]
    "yes",[Char]
    "always"] = Bool -> Either [Char] Bool
    forall a b. b -> Either a b
    Right Bool
    True
      | [Char]
    l [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]
    "n",[Char]
    "no",[Char]
    "never"]   = Bool -> Either [Char] Bool
    forall a b. b -> Either a b
    Right Bool
    False
      | Bool
    otherwise = [Char] -> Either [Char] Bool
    forall a b. a -> Either a b
    Left ([Char] -> Either [Char] Bool) -> [Char] -> Either [Char] Bool
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "value should be one of " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> ([Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " [[Char]
    "y",[Char]
    "yes",[Char]
    "n",[Char]
    "no"])
      where l :: [Char]
    l = (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    s

    data YNA = Yes | No | Auto deriving (YNA -> YNA -> Bool
    (YNA -> YNA -> Bool) -> (YNA -> YNA -> Bool) -> Eq YNA
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: YNA -> YNA -> Bool
    == :: YNA -> YNA -> Bool
    $c/= :: YNA -> YNA -> Bool
    /= :: YNA -> YNA -> Bool
    Eq,Int -> YNA -> [Char] -> [Char]
    [YNA] -> [Char] -> [Char]
    YNA -> [Char]
    (Int -> YNA -> [Char] -> [Char])
    -> (YNA -> [Char]) -> ([YNA] -> [Char] -> [Char]) -> Show YNA
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> YNA -> [Char] -> [Char]
    showsPrec :: Int -> YNA -> [Char] -> [Char]
    $cshow :: YNA -> [Char]
    show :: YNA -> [Char]
    $cshowList :: [YNA] -> [Char] -> [Char]
    showList :: [YNA] -> [Char] -> [Char]
    Show)

    -- | Parse y/yes/always or n/no/never or a/auto to a YNA choice, or return an error message.
    parseYNA :: String -> Either String YNA
    parseYNA :: [Char] -> Either [Char] YNA
    parseYNA [Char]
    s
      | [Char]
    l [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]
    "y",[Char]
    "yes",[Char]
    "always"] = YNA -> Either [Char] YNA
    forall a b. b -> Either a b
    Right YNA
    Yes
      | [Char]
    l [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]
    "n",[Char]
    "no",[Char]
    "never"]   = YNA -> Either [Char] YNA
    forall a b. b -> Either a b
    Right YNA
    No
      | [Char]
    l [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]
    "a",[Char]
    "auto"]         = YNA -> Either [Char] YNA
    forall a b. b -> Either a b
    Right YNA
    Auto
      | Bool
    otherwise = [Char] -> Either [Char] YNA
    forall a b. a -> Either a b
    Left ([Char] -> Either [Char] YNA) -> [Char] -> Either [Char] YNA
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "value should be one of " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> ([Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " [[Char]
    "y",[Char]
    "yes",[Char]
    "n",[Char]
    "no",[Char]
    "a",[Char]
    "auto"])
      where l :: [Char]
    l = (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    s

    -- | Is there a --output-file or -o option in the command line arguments ?
    -- Uses getOpt; sticky in GHCI until reloaded, may not always be affected by a hledger config file, etc.
    hasOutputFile :: IO Bool
    hasOutputFile :: IO Bool
    hasOutputFile = do
      mv <- [[Char]] -> IO (Maybe [Char])
    getOpt [[Char]
    "output-file",[Char]
    "o"]
      return $
        case mv of
          Maybe [Char]
    Nothing  -> Bool
    False
          Just [Char]
    "-" -> Bool
    False
          Maybe [Char]
    _        -> Bool
    True

    -- -- | Get the -o/--output-file option's value, if any, from the command line arguments.
    -- -- Uses getOpt; sticky in GHCI until reloaded, may not always be affected by a hledger config file, etc.
    -- outputFileOption :: IO (Maybe String)
    -- outputFileOption = getOpt ["output-file","o"]

    -- Terminal size

    -- [NOTE: Alternative methods of getting the terminal size]
    -- terminal-size uses the TIOCGWINSZ ioctl to get the window size on Unix
    -- systems, which may not be completely portable according to people in
    -- #linux@liberachat.
    --
    -- If this turns out to be the case, supplementary coverage can be given by
    -- using the terminfo package.
    --
    -- Conversely, terminfo on its own is not a full solution, firstly because it
    -- only works on Unix (not Windows), and secondly since in some scenarios (eg
    -- stripped-down build systems) the terminfo database may be limited and lack
    -- the correct entries. (A hack that sometimes works but which isn't robust
    -- enough to be relied upon is to set TERM=dumb -- while this advice does appear
    -- in some places, it's not guaranteed to work)
    --
    -- In any case, $LINES/$COLUMNS should not be used as a source for the terminal
    -- size - they are not available or do not update reliably in all shells.
    --
    -- See #2332 for details

    -- | An alternative to ansi-terminal's getTerminalSize, based on
    -- the more robust-looking terminal-size package.
    --
    -- Tries to get stdout's terminal's current height and width.
    getTerminalHeightWidth :: IO (Maybe (Int,Int))
    getTerminalHeightWidth :: IO (Maybe (Int, Int))
    getTerminalHeightWidth = (Maybe (Window Int) -> Maybe (Int, Int))
    -> IO (Maybe (Window Int)) -> IO (Maybe (Int, Int))
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Window Int -> (Int, Int))
    -> Maybe (Window Int) -> Maybe (Int, Int)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Window Int -> (Int, Int)
    forall {b}. Window b -> (b, b)
    unwindow) IO (Maybe (Window Int))
    forall n. Integral n => IO (Maybe (Window n))
    size
      where unwindow :: Window b -> (b, b)
    unwindow (Window b
    h b
    w) = (b
    h,b
    w)

    getTerminalHeight :: IO (Maybe Int)
    getTerminalHeight :: IO (Maybe Int)
    getTerminalHeight = ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst (Maybe (Int, Int) -> Maybe Int)
    -> IO (Maybe (Int, Int)) -> IO (Maybe Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe (Int, Int))
    getTerminalHeightWidth

    getTerminalWidth :: IO (Maybe Int)
    getTerminalWidth :: IO (Maybe Int)
    getTerminalWidth  = ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int, Int) -> Int
    forall a b. (a, b) -> b
    snd (Maybe (Int, Int) -> Maybe Int)
    -> IO (Maybe (Int, Int)) -> IO (Maybe Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe (Int, Int))
    getTerminalHeightWidth

    -- Pager output
    -- somewhat hledger-specific

    -- Configure some preferred options for the `less` pager,
    -- by modifying the LESS environment variable in this program's environment.
    -- If you are using some other pager, this will have no effect.
    -- By default, this sets the following options, appending them to LESS's current value:
    --
    --   --chop-long-lines
    --   --hilite-unread
    --   --ignore-case
    --   --no-init
    --   --quit-at-eof
    --   --quit-if-one-screen
    --   --RAW-CONTROL-CHARS
    --   --shift=8
    --   --squeeze-blank-lines
    --   --use-backslash
    --
    -- You can choose different options by setting the HLEDGER_LESS variable;
    -- if set, its value will be used instead of LESS.
    -- Or you can force hledger to use your exact LESS settings,
    -- by setting HLEDGER_LESS equal to LESS.
    --
    setupPager :: IO ()
    setupPager :: IO ()
    setupPager = do
      let
        -- keep synced with doc above
        deflessopts :: [Char]
    deflessopts = [[Char]] -> [Char]
    unwords [
           [Char]
    "--chop-long-lines"
          ,[Char]
    "--hilite-unread"
          ,[Char]
    "--ignore-case"
          ,[Char]
    "--no-init"
          ,[Char]
    "--quit-at-eof"
          ,[Char]
    "--quit-if-one-screen"
          ,[Char]
    "--RAW-CONTROL-CHARS"
          ,[Char]
    "--shift=8"
          ,[Char]
    "--squeeze-blank-lines"
          ,[Char]
    "--use-backslash"
          -- ,"--use-color"  #2335 rejected by older less versions (eg 551)
          ]
      mhledgerless <- [Char] -> IO (Maybe [Char])
    lookupEnv [Char]
    "HLEDGER_LESS"
      mless        <- lookupEnv "LESS"
      setEnv "LESS" $
        case (mhledgerless, mless) of
          (Just [Char]
    hledgerless, Maybe [Char]
    _) -> [Char]
    hledgerless
          (Maybe [Char]
    _, Just [Char]
    less)        -> if [Char]
    deflessopts [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` [Char]
    less then [Char]
    less else [[Char]] -> [Char]
    unwords [[Char]
    less, [Char]
    deflessopts]
          (Maybe [Char], Maybe [Char])
    _                     -> [Char]
    deflessopts

    -- | Display the given text on the terminal, trying to use a pager ($PAGER, less, or more)
    -- when appropriate, otherwise printing to standard output. Uses maybePagerFor.
    --
    -- hledger's output may contain ANSI style/color codes
    -- (if the terminal supports them and they are not disabled by --color=no or NO_COLOR),
    -- so the pager should be configured to handle these.
    -- setupPager tries to configure that automatically when using the `less` pager.
    --
    runPager :: String -> IO ()
    runPager :: [Char] -> IO ()
    runPager [Char]
    s = do
      mpager <- [Char] -> IO (Maybe [Char])
    maybePagerFor [Char]
    s
      case mpager of
        Maybe [Char]
    Nothing -> [Char] -> IO ()
    putStr [Char]
    s
        Just [Char]
    pager -> do
          CreateProcess
    -> (Maybe Handle
        -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
    -> IO ()
    forall a.
    CreateProcess
    -> (Maybe Handle
        -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
    -> IO a
    withCreateProcess ([Char] -> CreateProcess
    shell [Char]
    pager){std_in=CreatePipe} ((Maybe Handle
      -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
     -> IO ())
    -> (Maybe Handle
        -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            \Maybe Handle
    mhin Maybe Handle
    _ Maybe Handle
    _ ProcessHandle
    p -> do
              -- Pipe in the text on stdin.
              case Maybe Handle
    mhin of
                Maybe Handle
    Nothing  -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- shouldn't happen
                Just Handle
    hin -> IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $   -- Write from another thread to avoid deadlock ? Maybe unneeded, but just in case.
                  (Handle -> [Char] -> IO ()
    hPutStr Handle
    hin [Char]
    s IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    hin)  -- Be sure to close the pipe so the pager knows we're done.
                    -- If the pager quits early, we'll receive an EPIPE error; hide that.
                    IO () -> (IOException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \(IOException
    e::IOException) -> case IOException
    e of
                      IOError{ioe_type :: IOException -> IOErrorType
    ioe_type=IOErrorType
    ResourceVanished, ioe_errno :: IOException -> Maybe CInt
    ioe_errno=Just CInt
    ioe, ioe_handle :: IOException -> Maybe Handle
    ioe_handle=Just Handle
    hdl} | CInt -> Errno
    Errno CInt
    ioeErrno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Errno
    ePIPE, Handle
    hdlHandle -> Handle -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Handle
    hin
                        -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      IOException
    _ -> IOException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO IOException
    e
              IO ExitCode -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    p

    -- | Should a pager be used for displaying the given text on stdout, and if so, which one ?
    -- Uses a pager if findPager finds one and none of the following conditions are true:
    -- We're running in a native MS Windows environment like cmd or powershell.
    -- Or the --pager=n|no option is in effect.
    -- Or the -o/--output-file option is in effect.
    -- Or INSIDE_EMACS is set, to something other than "vterm".
    -- Or the terminal's current height and width can't be detected.
    -- Or the output text is less wide and less tall than the terminal.
    -- Throws an error if the --pager option's value could not be parsed.
    maybePagerFor :: String -> IO (Maybe String)
    maybePagerFor :: [Char] -> IO (Maybe [Char])
    maybePagerFor [Char]
    output = do
      let
        ls :: [[Char]]
    ls = [Char] -> [[Char]]
    lines [Char]
    output
        oh :: Int
    oh = [[Char]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Char]]
    ls
        ow :: Int
    ow = Int -> [Int] -> Int
    forall a. Ord a => a -> [a] -> a
    maximumDef Int
    0 ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Int) -> [[Char]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Char]]
    ls
        windows :: Bool
    windows = [Char]
    os [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "mingw32"
      pagerno    <- Bool -> ([Char] -> Bool) -> Maybe [Char] -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Bool -> Bool
    not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> Bool) -> (Bool -> Bool) -> Either [Char] Bool -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either [Char] -> Bool
    forall a. [Char] -> a
    error' Bool -> Bool
    forall a. a -> a
    id (Either [Char] Bool -> Bool)
    -> ([Char] -> Either [Char] Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Either [Char] Bool
    parseYN) (Maybe [Char] -> Bool) -> IO (Maybe [Char]) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [[Char]] -> IO (Maybe [Char])
    getOpt [[Char]
    "pager"]
      outputfile <- hasOutputFile
      emacsterm  <- lookupEnv "INSIDE_EMACS" <&> (`notElem` [Nothing, Just "vterm"])
      mhw        <- getTerminalHeightWidth
      mpager     <- findPager
      return $ do
        guard $ not $ windows || pagerno || outputfile || emacsterm
        (th,tw) <- mhw
        guard $ oh > th || ow > tw
        mpager

    -- | Try to find a pager executable robustly, safely handling various error conditions
    -- like an unset PATH var or the specified pager not being found as an executable.
    -- The pager can be specified by a path or program name in the PAGER environment variable.
    -- If that is unset or has a problem, "less" is tried, then "more".
    -- If successful, the pager's path or program name is returned.
    findPager :: IO (Maybe String)  -- XXX probably a ByteString in fact ?
    findPager :: IO (Maybe [Char])
    findPager = do
      mpagervar <- [Char] -> IO (Maybe [Char])
    lookupEnv [Char]
    "PAGER"
      let pagers = [[Char]
    p | Just [Char]
    p <- [Maybe [Char]
    mpagervar]] [[Char]] -> [[Char]] -> [[Char]]
    forall a. Semigroup a => a -> a -> a
    <> [[Char]
    "less", [Char]
    "more"]
      headMay . catMaybes <$> mapM findExecutable pagers

    -- ANSI colour/styles
    -- Some of these use unsafePerformIO to read info.

    -- hledger-specific:

    -- | Get the value of the rightmost --color or --colour option from the program's command line arguments.
    -- Throws an error if the option's value could not be parsed.
    colorOption :: IO YNA
    colorOption :: IO YNA
    colorOption = YNA -> ([Char] -> YNA) -> Maybe [Char] -> YNA
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe YNA
    Auto (([Char] -> YNA) -> (YNA -> YNA) -> Either [Char] YNA -> YNA
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either [Char] -> YNA
    forall a. [Char] -> a
    error' YNA -> YNA
    forall a. a -> a
    id (Either [Char] YNA -> YNA)
    -> ([Char] -> Either [Char] YNA) -> [Char] -> YNA
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Either [Char] YNA
    parseYNA) (Maybe [Char] -> YNA) -> IO (Maybe [Char]) -> IO YNA
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [[Char]] -> IO (Maybe [Char])
    getOpt [[Char]
    "color",[Char]
    "colour"]

    -- | Should ANSI color and styles be used with this output handle ?
    -- Considers colorOption, the NO_COLOR environment variable, and hSupportsANSIColor.
    useColorOnHandle :: Handle -> IO Bool
    useColorOnHandle :: Handle -> IO Bool
    useColorOnHandle Handle
    h = do
      no_color       <- Maybe [Char] -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe [Char] -> Bool) -> IO (Maybe [Char]) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO (Maybe [Char])
    lookupEnv [Char]
    "NO_COLOR"
      supports_color <- hSupportsANSIColor h
      yna            <- colorOption
      return $ yna==Yes || (yna==Auto && not no_color && supports_color)

    -- | Should ANSI color and styles be used for standard output ?
    -- Considers useColorOnHandle stdout and hasOutputFile.
    useColorOnStdout :: IO Bool
    useColorOnStdout :: IO Bool
    useColorOnStdout = do
      nooutputfile <- Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Bool
    hasOutputFile
      usecolor <- useColorOnHandle stdout
      return $ nooutputfile && usecolor

    -- | Should ANSI color and styles be used for standard error output ?
    -- Considers useColorOnHandle stderr; is not affected by an --output-file option.
    useColorOnStderr :: IO Bool
    useColorOnStderr :: IO Bool
    useColorOnStderr = Handle -> IO Bool
    useColorOnHandle Handle
    stderr

    -- | Like useColorOnStdout, but using unsafePerformIO. Useful eg for low-level debug code.
    -- Sticky in GHCI until reloaded, may not always be affected by --color in a hledger config file, etc.
    useColorOnStdoutUnsafe :: Bool
    useColorOnStdoutUnsafe :: Bool
    useColorOnStdoutUnsafe = IO Bool -> Bool
    forall a. IO a -> a
    unsafePerformIO IO Bool
    useColorOnStdout

    -- | Like useColorOnStdoutUnsafe, but for stderr.
    useColorOnStderrUnsafe :: Bool
    useColorOnStderrUnsafe :: Bool
    useColorOnStderrUnsafe = IO Bool -> Bool
    forall a. IO a -> a
    unsafePerformIO IO Bool
    useColorOnStderr

    -- | 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 (the commands list, the recentassertions error message, add, demo);
    -- see useColorOnStdoutUnsafe's limitations.
    ansiWrapUnsafe :: SGRString -> SGRString -> String -> String
    ansiWrapUnsafe :: [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    pre [Char]
    post [Char]
    s = if Bool
    useColorOnStdoutUnsafe then [Char]
    pre[Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>[Char]
    s[Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>[Char]
    post else [Char]
    s

    type SGRString = String

    sgrbold :: [Char]
    sgrbold          = [SGR] -> [Char]
    setSGRCode [ConsoleIntensity -> SGR
    SetConsoleIntensity ConsoleIntensity
    BoldIntensity]
    sgrfaint :: [Char]
    sgrfaint         = [SGR] -> [Char]
    setSGRCode [ConsoleIntensity -> SGR
    SetConsoleIntensity ConsoleIntensity
    FaintIntensity]
    sgrnormal :: [Char]
    sgrnormal        = [SGR] -> [Char]
    setSGRCode [ConsoleIntensity -> SGR
    SetConsoleIntensity ConsoleIntensity
    NormalIntensity]
    sgrresetfg :: [Char]
    sgrresetfg       = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> SGR
    SetDefaultColor ConsoleLayer
    Foreground]
    sgrresetbg :: [Char]
    sgrresetbg       = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> SGR
    SetDefaultColor ConsoleLayer
    Background]
    sgrresetall :: [Char]
    sgrresetall      = [Char]
    sgrresetfg [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    sgrresetbg [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    sgrnormal
    sgrblack :: [Char]
    sgrblack         = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Black]
    sgrred :: [Char]
    sgrred           = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Red]
    sgrgreen :: [Char]
    sgrgreen         = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Green]
    sgryellow :: [Char]
    sgryellow        = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Yellow]
    sgrblue :: [Char]
    sgrblue          = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Blue]
    sgrmagenta :: [Char]
    sgrmagenta       = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Magenta]
    sgrcyan :: [Char]
    sgrcyan          = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Cyan]
    sgrwhite :: [Char]
    sgrwhite         = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    White]
    sgrbrightblack :: [Char]
    sgrbrightblack   = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Black]
    sgrbrightred :: [Char]
    sgrbrightred     = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Red]
    sgrbrightgreen :: [Char]
    sgrbrightgreen   = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Green]
    sgrbrightyellow :: [Char]
    sgrbrightyellow  = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Yellow]
    sgrbrightblue :: [Char]
    sgrbrightblue    = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Blue]
    sgrbrightmagenta :: [Char]
    sgrbrightmagenta = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Magenta]
    sgrbrightcyan :: [Char]
    sgrbrightcyan    = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Cyan]
    sgrbrightwhite :: [Char]
    sgrbrightwhite   = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    White]
    sgrrgb :: Float -> Float -> Float -> [Char]
    sgrrgb Float
    r Float
    g Float
    b     = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> Colour Float -> SGR
    SetRGBColor ConsoleLayer
    Foreground (Colour Float -> SGR) -> Colour Float -> SGR
    forall a b. (a -> b) -> a -> b
    $ Float -> Float -> Float -> Colour Float
    forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
    sRGB Float
    r Float
    g Float
    b]

    -- | Set various ANSI styles/colours in a string, only if useColorOnStdoutUnsafe says we should.
    bold' :: String -> String
    bold' :: [Char] -> [Char]
    bold'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbold [Char]
    sgrnormal

    faint' :: String -> String
    faint' :: [Char] -> [Char]
    faint'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrfaint [Char]
    sgrnormal

    black' :: String -> String
    black' :: [Char] -> [Char]
    black'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrblack [Char]
    sgrresetfg

    red' :: String -> String
    red' :: [Char] -> [Char]
    red'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrred [Char]
    sgrresetfg

    green' :: String -> String
    green' :: [Char] -> [Char]
    green'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrgreen [Char]
    sgrresetfg

    yellow' :: String -> String
    yellow' :: [Char] -> [Char]
    yellow'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgryellow [Char]
    sgrresetfg

    blue' :: String -> String
    blue' :: [Char] -> [Char]
    blue'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrblue [Char]
    sgrresetfg

    magenta' :: String -> String
    magenta' :: [Char] -> [Char]
    magenta'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrmagenta [Char]
    sgrresetfg

    cyan' :: String -> String
    cyan' :: [Char] -> [Char]
    cyan'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrcyan [Char]
    sgrresetfg

    white' :: String -> String
    white' :: [Char] -> [Char]
    white'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrwhite [Char]
    sgrresetfg

    brightBlack' :: String -> String
    brightBlack' :: [Char] -> [Char]
    brightBlack'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbrightblack [Char]
    sgrresetfg

    brightRed' :: String -> String
    brightRed' :: [Char] -> [Char]
    brightRed'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbrightred [Char]
    sgrresetfg

    brightGreen' :: String -> String
    brightGreen' :: [Char] -> [Char]
    brightGreen'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbrightgreen [Char]
    sgrresetfg

    brightYellow' :: String -> String
    brightYellow' :: [Char] -> [Char]
    brightYellow'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbrightyellow [Char]
    sgrresetfg

    brightBlue' :: String -> String
    brightBlue' :: [Char] -> [Char]
    brightBlue'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbrightblue [Char]
    sgrresetfg

    brightMagenta' :: String -> String
    brightMagenta' :: [Char] -> [Char]
    brightMagenta'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbrightmagenta [Char]
    sgrresetfg

    brightCyan' :: String -> String
    brightCyan' :: [Char] -> [Char]
    brightCyan'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbrightcyan [Char]
    sgrresetfg

    brightWhite' :: String -> String
    brightWhite' :: [Char] -> [Char]
    brightWhite'  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe [Char]
    sgrbrightwhite [Char]
    sgrresetfg

    rgb' :: Float -> Float -> Float -> String -> String
    rgb' :: Float -> Float -> Float -> [Char] -> [Char]
    rgb' Float
    r Float
    g Float
    b  = [Char] -> [Char] -> [Char] -> [Char]
    ansiWrapUnsafe (Float -> Float -> Float -> [Char]
    sgrrgb Float
    r Float
    g Float
    b) [Char]
    sgrresetfg

    -- Generic:

    -- | Wrap a string in ANSI codes to set and reset foreground colour.
    -- ColorIntensity is @Dull@ or @Vivid@ (ie normal and bold).
    -- Color is one of @Black@, @Red@, @Green@, @Yellow@, @Blue@, @Magenta@, @Cyan@, @White@.
    -- Eg: @color Dull Red "text"@.
    color :: ColorIntensity -> Color -> String -> String
    color :: ColorIntensity -> Color -> [Char] -> [Char]
    color ColorIntensity
    int Color
    col [Char]
    s = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    int Color
    col] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [SGR] -> [Char]
    setSGRCode []

    -- | Wrap a string in ANSI codes to set and reset background colour.
    bgColor :: ColorIntensity -> Color -> String -> String
    bgColor :: ColorIntensity -> Color -> [Char] -> [Char]
    bgColor ColorIntensity
    int Color
    col [Char]
    s = [SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Background ColorIntensity
    int Color
    col] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [SGR] -> [Char]
    setSGRCode []

    -- | Wrap a WideBuilder in ANSI codes to set and reset foreground colour.
    colorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
    colorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
    colorB ColorIntensity
    int Color
    col (WideBuilder Builder
    s Int
    w) =
        Builder -> Int -> WideBuilder
    WideBuilder ([Char] -> Builder
    TB.fromString ([SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    int Color
    col]) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    s Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    TB.fromString ([SGR] -> [Char]
    setSGRCode [])) Int
    w

    -- | Wrap a WideBuilder in ANSI codes to set and reset background colour.
    bgColorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
    bgColorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
    bgColorB ColorIntensity
    int Color
    col (WideBuilder Builder
    s Int
    w) =
        Builder -> Int -> WideBuilder
    WideBuilder ([Char] -> Builder
    TB.fromString ([SGR] -> [Char]
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Background ColorIntensity
    int Color
    col]) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    s Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    TB.fromString ([SGR] -> [Char]
    setSGRCode [])) Int
    w

    -- | Detect whether the terminal currently has a light background colour,
    -- if possible, using unsafePerformIO.
    -- If the terminal is transparent, its apparent light/darkness may be different.
    terminalIsLight :: Maybe Bool
    terminalIsLight :: Maybe Bool
    terminalIsLight = (Float -> Float -> Bool
    forall a. Ord a => a -> a -> Bool
    > Float
    0.5) (Float -> Bool) -> Maybe Float -> Maybe Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Float
    terminalLightness

    -- | Detect the terminal's current background lightness (0..1), if possible, using unsafePerformIO.
    -- If the terminal is transparent, its apparent lightness may be different.
    terminalLightness :: Maybe Float
    terminalLightness :: Maybe Float
    terminalLightness = RGB Float -> Float
    forall a. (Fractional a, Ord a) => RGB a -> a
    lightness (RGB Float -> Float) -> Maybe (RGB Float) -> Maybe Float
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ConsoleLayer -> Maybe (RGB Float)
    terminalColor ConsoleLayer
    Background

    -- | Detect the terminal's current background colour, if possible, using unsafePerformIO.
    terminalBgColor :: Maybe (RGB Float)
    terminalBgColor :: Maybe (RGB Float)
    terminalBgColor = ConsoleLayer -> Maybe (RGB Float)
    terminalColor ConsoleLayer
    Background

    -- | Detect the terminal's current foreground colour, if possible, using unsafePerformIO.
    terminalFgColor :: Maybe (RGB Float)
    terminalFgColor :: Maybe (RGB Float)
    terminalFgColor = ConsoleLayer -> Maybe (RGB Float)
    terminalColor ConsoleLayer
    Foreground

    -- | Detect the terminal's current foreground or background colour, if possible, using unsafePerformIO.
    {-# NOINLINE terminalColor #-}
    terminalColor :: ConsoleLayer -> Maybe (RGB Float)
    terminalColor :: ConsoleLayer -> Maybe (RGB Float)
    terminalColor = IO (Maybe (RGB Float)) -> Maybe (RGB Float)
    forall a. IO a -> a
    unsafePerformIO (IO (Maybe (RGB Float)) -> Maybe (RGB Float))
    -> (ConsoleLayer -> IO (Maybe (RGB Float)))
    -> ConsoleLayer
    -> Maybe (RGB Float)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConsoleLayer -> IO (Maybe (RGB Float))
    getLayerColor'

    -- A version of ansi-terminal's getLayerColor that is less likely to leak escape sequences to output,
    -- and that returns a RGB of Floats (0..1) that is more compatible with the colour package.
    -- This does nothing in a non-interactive context (eg when piping stdout to another command),
    -- inside emacs (emacs shell buffers show the escape sequence for some reason),
    -- or in a non-colour-supporting terminal.
    getLayerColor' :: ConsoleLayer -> IO (Maybe (RGB Float))
    getLayerColor' :: ConsoleLayer -> IO (Maybe (RGB Float))
    getLayerColor' ConsoleLayer
    l = do
      inemacs       <- Bool -> Bool
    not(Bool -> Bool) -> (Maybe [Char] -> Bool) -> Maybe [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Maybe [Char] -> Bool
    forall a. Maybe a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Maybe [Char] -> Bool) -> IO (Maybe [Char]) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO (Maybe [Char])
    lookupEnv [Char]
    "INSIDE_EMACS"
      interactive   <- hIsTerminalDevice stdout
      supportscolor <- hSupportsANSIColor stdout
      if inemacs || not interactive || not supportscolor then return Nothing
      else fmap fractionalRGB <$> getLayerColor l
      where
        fractionalRGB :: (Fractional a) => RGB Word16 -> RGB a
        fractionalRGB :: forall a. Fractional a => RGB Word16 -> RGB a
    fractionalRGB (RGB Word16
    r Word16
    g Word16
    b) = a -> a -> a -> RGB a
    forall a. a -> a -> a -> RGB a
    RGB (Word16 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    r a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    65535) (Word16 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    g a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    65535) (Word16 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    b a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    65535)  -- chatgpt