    {- |
    Helpers for pretty-printing haskell values, reading command line arguments,
    working with ANSI colours, files, and time.
    Uses unsafePerformIO.

    Limitations:
    When running in GHCI, this module must be reloaded to see environmental changes.
    The colour scheme may be somewhat hard-coded.

    -}

    {-# LANGUAGE CPP, LambdaCase #-}

    module Hledger.Utils.IO (

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

      -- * Viewing with pager
      pager,
      setupPager,

      -- * Terminal size
      getTerminalHeightWidth,
      getTerminalHeight,
      getTerminalWidth,

      -- * Command line arguments
      progArgs,
      outputFileOption,
      hasOutputFile,

      -- * ANSI color
      colorOption,
      useColorOnStdout,
      useColorOnStderr,
      -- XXX needed for using color/bgColor/colorB/bgColorB, but clashing with UIUtils:
      -- Color(..),
      -- ColorIntensity(..),
      color,
      bgColor,
      colorB,
      bgColorB,
      --
      bold',
      faint',
      black',
      red',
      green',
      yellow',
      blue',
      magenta',
      cyan',
      white',
      brightBlack',
      brightRed',
      brightGreen',
      brightYellow',
      brightBlue',
      brightMagenta',
      brightCyan',
      brightWhite',
      rgb',
      terminalIsLight,
      terminalLightness,
      terminalFgColor,
      terminalBgColor,

      -- * Errors
      error',
      usageError,

      -- * Files
      embedFileRelative,
      expandHomePath,
      expandPath,
      expandGlob,
      sortByModTime,
      readFileOrStdinPortably,
      readFilePortably,
      readHandlePortably,
      -- hereFileRelative,

      -- * Time
      getCurrentLocalTime,
      getCurrentZonedTime,

      )
    where

    import           Control.Monad (when, forM)
    import           Data.Colour.RGBSpace (RGB(RGB))
    import           Data.Colour.RGBSpace.HSL (lightness)
    import           Data.FileEmbed (makeRelativeToProject, embedStringFile)
    import           Data.List hiding (uncons)
    import           Data.Maybe (isJust)
    import qualified Data.Text as T
    import qualified Data.Text.IO as T
    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           Language.Haskell.TH.Syntax (Q, Exp)
    import           String.ANSI
    import           System.Console.ANSI (Color(..),ColorIntensity(..),
      ConsoleLayer(..), SGR(..), hSupportsANSIColor, setSGRCode, getLayerColor)
    import           System.Console.Terminal.Size (Window (Window), size)
    import           System.Directory (getHomeDirectory, getModificationTime)
    import           System.Environment (getArgs, lookupEnv, setEnv)
    import           System.FilePath (isRelative, (</>))
    import           System.IO
      (Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode,
       openFile, stdin, stdout, stderr, universalNewlineMode, utf8_bom, hIsTerminalDevice)
    import           System.IO.Unsafe (unsafePerformIO)
    #ifndef mingw32_HOST_OS
    import           System.Pager (printOrPage)
    #endif
    import           Text.Pretty.Simple
      (CheckColorTty(..), OutputOptions(..),
      defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt)

    import Hledger.Utils.Text (WideBuilder(WideBuilder))
    import System.FilePath.Glob (glob)
    import Data.Functor ((<&>))

    -- Pretty showing/printing with 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
    useColorOnStderr then OutputOptions
    defaultOutputOptionsDarkBg else OutputOptions
    defaultOutputOptionsNoColor)
        { outputOptionsIndentAmount :: Int
    outputOptionsIndentAmount = Int
    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 :: Int
    outputOptionsIndentAmount=Int
    2
        }

    -- | Pretty show. An easier alias for pretty-simple's pShow.
    -- This will probably show in colour if useColorOnStderr is true.
    pshow :: Show a => a -> String
    pshow :: forall a. Show a => a -> String
    pshow = Text -> String
    TL.unpack (Text -> String) -> (a -> Text) -> a -> String
    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 -> String
    pshow' = Text -> String
    TL.unpack (Text -> String) -> (a -> Text) -> a -> String
    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 useColorOnStderr 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
    useColorOnStderr 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." (?)

    -- | Display the given text on the terminal, using the user's $PAGER if the text is taller
    -- than the current terminal and stdout is interactive and TERM is not "dumb"
    -- (except on Windows, where a pager will not be used).
    -- If the text contains ANSI codes, because hledger thinks the current terminal
    -- supports those, the pager should be configured to display those, otherwise
    -- users will see junk on screen (#2015).
    -- We call "setLessR" at hledger startup to make that less likely.
    pager :: String -> IO ()
    #ifdef mingw32_HOST_OS
    pager = putStrLn
    #else
    printOrPage' :: String -> IO ()
    printOrPage' String
    s = do  -- an extra check for Emacs users:
      Bool
    dumbterm <- (Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "dumb") (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Maybe String)
    lookupEnv String
    "TERM"
      if Bool
    dumbterm then String -> IO ()
    putStrLn String
    s else Text -> IO ()
    printOrPage (String -> Text
    T.pack String
    s)
    pager :: String -> IO ()
    pager = String -> IO ()
    printOrPage'
    #endif

    -- | 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

    -- | Make sure our $LESS and $MORE environment variables contain R,
    -- to help ensure the common pager `less` will show our ANSI output properly.
    -- less uses $LESS by default, and $MORE when it is invoked as `more`.
    -- What the original `more` program does, I'm not sure.
    -- If $PAGER is configured to something else, this probably will have no effect.
    setupPager :: IO ()
    setupPager :: IO ()
    setupPager = do
      let
        addR :: String -> IO ()
    addR String
    var = do
          Maybe String
    mv <- String -> IO (Maybe String)
    lookupEnv String
    var
          String -> String -> IO ()
    setEnv String
    var (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case Maybe String
    mv of
            Maybe String
    Nothing -> String
    "R"
            Just String
    v  -> (Char
    'R'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    v)
      String -> IO ()
    addR String
    "LESS"
      String -> IO ()
    addR String
    "MORE"

    -- Command line arguments

    -- | The command line arguments that were used at program startup.
    -- Uses unsafePerformIO.
    {-# NOINLINE progArgs #-}
    progArgs :: [String]
    progArgs :: [String]
    progArgs = IO [String] -> [String]
    forall a. IO a -> a
    unsafePerformIO IO [String]
    getArgs

    -- | Read the value of the -o/--output-file command line option provided at program startup,
    -- if any, using unsafePerformIO.
    outputFileOption :: Maybe String
    outputFileOption :: Maybe String
    outputFileOption =
      -- keep synced with output-file flag definition in hledger:CliOptions.
      let args :: [String]
    args = [String]
    progArgs in
      case (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "-o" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`)) [String]
    args of
        -- -oARG
        (Char
    '-':Char
    'o':v :: String
    v@(Char
    _:String
    _)):[String]
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    v
        -- -o ARG
        String
    "-o":String
    v:[String]
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    v
        [String]
    _ ->
          case (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /=String
    "--output-file") [String]
    args of
            -- --output-file ARG
            String
    "--output-file":String
    v:[String]
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    v
            [String]
    _ ->
              case Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String
    "--output-file=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    args of
                -- --output=file=ARG
                [Char
    '-':Char
    '-':Char
    'o':Char
    'u':Char
    't':Char
    'p':Char
    'u':Char
    't':Char
    '-':Char
    'f':Char
    'i':Char
    'l':Char
    'e':Char
    '=':String
    v] -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    v
                [String]
    _ -> Maybe String
    forall a. Maybe a
    Nothing

    -- | Check whether the -o/--output-file option has been used at program startup
    -- with an argument other than "-", using unsafePerformIO.
    hasOutputFile :: Bool
    hasOutputFile :: Bool
    hasOutputFile = Maybe String
    outputFileOption Maybe String -> [Maybe String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Maybe String
    forall a. Maybe a
    Nothing, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "-"]
    -- XXX shouldn't we check that stdout is interactive. instead ?

    -- ANSI colour

    ifAnsi :: (a -> a) -> a -> a
    ifAnsi a -> a
    f = if Bool
    useColorOnStdout then a -> a
    f else a -> a
    forall a. a -> a
    id

    -- | Versions of some of text-ansi's string colors/styles which are more careful
    -- to not print junk onscreen. These use our useColorOnStdout.
    bold' :: String -> String
    bold' :: String -> String
    bold'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    bold

    faint' :: String -> String
    faint' :: String -> String
    faint'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    faint

    black' :: String -> String
    black' :: String -> String
    black'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    black

    red' :: String -> String
    red' :: String -> String
    red'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    red

    green' :: String -> String
    green' :: String -> String
    green'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    green

    yellow' :: String -> String
    yellow' :: String -> String
    yellow'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    yellow

    blue' :: String -> String
    blue' :: String -> String
    blue'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    blue

    magenta' :: String -> String
    magenta' :: String -> String
    magenta'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    magenta

    cyan' :: String -> String
    cyan' :: String -> String
    cyan'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    cyan

    white' :: String -> String
    white' :: String -> String
    white'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    white

    brightBlack' :: String -> String
    brightBlack' :: String -> String
    brightBlack'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    brightBlack

    brightRed' :: String -> String
    brightRed' :: String -> String
    brightRed'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    brightRed

    brightGreen' :: String -> String
    brightGreen' :: String -> String
    brightGreen'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    brightGreen

    brightYellow' :: String -> String
    brightYellow' :: String -> String
    brightYellow'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    brightYellow

    brightBlue' :: String -> String
    brightBlue' :: String -> String
    brightBlue'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    brightBlue

    brightMagenta' :: String -> String
    brightMagenta' :: String -> String
    brightMagenta'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    brightMagenta

    brightCyan' :: String -> String
    brightCyan' :: String -> String
    brightCyan'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    brightCyan

    brightWhite' :: String -> String
    brightWhite' :: String -> String
    brightWhite'  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi String -> String
    brightWhite

    rgb' :: Word8 -> Word8 -> Word8 -> String -> String
    rgb' :: Word8 -> Word8 -> Word8 -> String -> String
    rgb' Word8
    r Word8
    g Word8
    b  = (String -> String) -> String -> String
    forall {a}. (a -> a) -> a -> a
    ifAnsi (Word8 -> Word8 -> Word8 -> String -> String
    rgb Word8
    r Word8
    g Word8
    b)

    -- | Read the value of the --color or --colour command line option provided at program startup
    -- using unsafePerformIO. If this option was not provided, returns the empty string.
    colorOption :: String
    colorOption :: String
    colorOption =
      -- similar to debugLevel
      -- keep synced with color/colour flag definition in hledger:CliOptions
      let args :: [String]
    args = [String]
    progArgs in
      case (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /=String
    "--color") [String]
    args of
        -- --color ARG
        String
    "--color":String
    v:[String]
    _ -> String
    v
        [String]
    _ ->
          case Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String
    "--color=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    args of
            -- --color=ARG
            [Char
    '-':Char
    '-':Char
    'c':Char
    'o':Char
    'l':Char
    'o':Char
    'r':Char
    '=':String
    v] -> String
    v
            [String]
    _ ->
              case (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /=String
    "--colour") [String]
    args of
                -- --colour ARG
                String
    "--colour":String
    v:[String]
    _ -> String
    v
                [String]
    _ ->
                  case Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String
    "--colour=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    args of
                    -- --colour=ARG
                    [Char
    '-':Char
    '-':Char
    'c':Char
    'o':Char
    'l':Char
    'o':Char
    'u':Char
    'r':Char
    '=':String
    v] -> String
    v
                    [String]
    _ -> String
    ""

    -- | Check the IO environment to see if ANSI colour codes should be used on stdout.
    -- This is done using unsafePerformIO so it can be used anywhere, eg in
    -- low-level debug utilities, which should be ok since we are just reading.
    -- The logic is: use color if
    -- the program was started with --color=yes|always
    -- or (
    --   the program was not started with --color=no|never
    --   and a NO_COLOR environment variable is not defined
    --   and stdout supports ANSI color
    --   and -o/--output-file was not used, or its value is "-"
    -- ).
    useColorOnStdout :: Bool
    useColorOnStdout :: Bool
    useColorOnStdout = Bool -> Bool
    not Bool
    hasOutputFile Bool -> Bool -> Bool
    && Handle -> Bool
    useColorOnHandle Handle
    stdout

    -- | Like useColorOnStdout, but checks for ANSI color support on stderr,
    -- and is not affected by -o/--output-file.
    useColorOnStderr :: Bool
    useColorOnStderr :: Bool
    useColorOnStderr = Handle -> Bool
    useColorOnHandle Handle
    stderr

    useColorOnHandle :: Handle -> Bool
    useColorOnHandle :: Handle -> Bool
    useColorOnHandle Handle
    h = IO Bool -> Bool
    forall a. IO a -> a
    unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ do
      Bool
    no_color       <- Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Maybe String)
    lookupEnv String
    "NO_COLOR"
      Bool
    supports_color <- Handle -> IO Bool
    hSupportsANSIColor Handle
    h
      let coloroption :: String
    coloroption = String
    colorOption
      Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ String
    coloroption String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String
    "always",String
    "yes"]
           Bool -> Bool -> Bool
    || (String
    coloroption String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [String
    "never",String
    "no"] Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    no_color Bool -> Bool -> Bool
    && Bool
    supports_color)

    -- | 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 -> String -> String
    color ColorIntensity
    int Color
    col String
    s = [SGR] -> String
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    int Color
    col] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [SGR] -> String
    setSGRCode []

    -- | Wrap a string in ANSI codes to set and reset background colour.
    bgColor :: ColorIntensity -> Color -> String -> String
    bgColor :: ColorIntensity -> Color -> String -> String
    bgColor ColorIntensity
    int Color
    col String
    s = [SGR] -> String
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Background ColorIntensity
    int Color
    col] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [SGR] -> String
    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 (String -> Builder
    TB.fromString ([SGR] -> String
    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
    <> String -> Builder
    TB.fromString ([SGR] -> String
    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 (String -> Builder
    TB.fromString ([SGR] -> String
    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
    <> String -> Builder
    TB.fromString ([SGR] -> String
    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 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
      Bool
    inemacs       <- Bool -> Bool
    not(Bool -> Bool) -> (Maybe String -> Bool) -> Maybe String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Maybe String -> Bool
    forall a. Maybe a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Maybe String)
    lookupEnv String
    "INSIDE_EMACS"
      Bool
    interactive   <- Handle -> IO Bool
    hIsTerminalDevice Handle
    stdout
      Bool
    supportscolor <- Handle -> IO Bool
    hSupportsANSIColor Handle
    stdout
      if Bool
    inemacs Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    interactive Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    supportscolor then Maybe (RGB Float) -> IO (Maybe (RGB Float))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (RGB Float)
    forall a. Maybe a
    Nothing
      else (RGB Word16 -> RGB Float)
    -> Maybe (RGB Word16) -> Maybe (RGB Float)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap RGB Word16 -> RGB Float
    forall a. Fractional a => RGB Word16 -> RGB a
    fractionalRGB (Maybe (RGB Word16) -> Maybe (RGB Float))
    -> IO (Maybe (RGB Word16)) -> IO (Maybe (RGB Float))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ConsoleLayer -> IO (Maybe (RGB Word16))
    getLayerColor ConsoleLayer
    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

    -- Errors

    -- | Simpler alias for errorWithoutStackTrace
    error' :: String -> a
    error' :: forall a. String -> a
    error' = String -> a
    forall a. String -> a
    errorWithoutStackTrace (String -> a) -> (String -> String) -> String -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "Error: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <>)

    -- | A version of errorWithoutStackTrace that adds a usage hint.
    usageError :: String -> a
    usageError :: forall a. String -> a
    usageError = String -> a
    forall a. String -> a
    error' (String -> a) -> (String -> String) -> String -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (use -h to see usage)")

    -- Files

    -- | 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 :: String -> IO String
    expandHomePath = \case
        (Char
    '~':Char
    '/':String
    p)  -> (String -> String -> String
    </> String
    p) (String -> String) -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO String
    getHomeDirectory
        (Char
    '~':Char
    '\\':String
    p) -> (String -> String -> String
    </> String
    p) (String -> String) -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO String
    getHomeDirectory
        (Char
    '~':String
    _)      -> IOError -> IO String
    forall a. IOError -> IO a
    ioError (IOError -> IO String) -> IOError -> IO String
    forall a b. (a -> b) -> a -> b
    $ String -> IOError
    userError String
    "~USERNAME in paths is not supported"
        String
    p            -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    p

    -- | Given a current directory, convert a possibly relative, possibly tilde-containing
    -- 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 :: String -> String -> IO String
    expandPath String
    _ String
    "-" = String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "-"
    expandPath String
    curdir String
    p = (if String -> Bool
    isRelative String
    p then (String
    curdir String -> String -> String
    </>) else String -> String
    forall a. a -> a
    id) (String -> String) -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO String
    expandHomePath String
    p

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

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

    -- | 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 :: String -> IO Text
    readFilePortably String
    f =  String -> IOMode -> IO Handle
    openFile String
    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 :: String -> IO Text
    readFileOrStdinPortably String
    f = String -> IOMode -> IO Handle
    openFileOrStdin String
    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
      where
        openFileOrStdin :: String -> IOMode -> IO Handle
        openFileOrStdin :: String -> IOMode -> IO Handle
    openFileOrStdin String
    "-" IOMode
    _ = Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    stdin
        openFileOrStdin String
    f' IOMode
    m   = String -> IOMode -> IO Handle
    openFile String
    f' IOMode
    m

    readHandlePortably :: Handle -> IO T.Text
    readHandlePortably :: Handle -> IO Text
    readHandlePortably Handle
    h = do
      Handle -> NewlineMode -> IO ()
    hSetNewlineMode Handle
    h NewlineMode
    universalNewlineMode
      Maybe TextEncoding
    menc <- Handle -> IO (Maybe TextEncoding)
    hGetEncoding Handle
    h
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((TextEncoding -> String) -> Maybe TextEncoding -> Maybe String
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TextEncoding -> String
    forall a. Show a => a -> String
    show Maybe TextEncoding
    menc Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "UTF-8") (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $  -- XXX no Eq instance, rely on Show
        Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    h TextEncoding
    utf8_bom
      Handle -> IO Text
    T.hGetContents Handle
    h

    -- | Like embedFile, but takes a path relative to the package directory.
    embedFileRelative :: FilePath -> Q Exp
    embedFileRelative :: String -> Q Exp
    embedFileRelative String
    f = String -> Q String
    makeRelativeToProject String
    f Q String -> (String -> 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
    >>= String -> 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

    -- Time

    getCurrentLocalTime :: IO LocalTime
    getCurrentLocalTime :: IO LocalTime
    getCurrentLocalTime = do
      UTCTime
    t <- IO UTCTime
    getCurrentTime
      TimeZone
    tz <- IO TimeZone
    getCurrentTimeZone
      LocalTime -> IO LocalTime
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LocalTime -> IO LocalTime) -> LocalTime -> IO LocalTime
    forall a b. (a -> b) -> a -> b
    $ TimeZone -> UTCTime -> LocalTime
    utcToLocalTime TimeZone
    tz UTCTime
    t

    getCurrentZonedTime :: IO ZonedTime
    getCurrentZonedTime :: IO ZonedTime
    getCurrentZonedTime = do
      UTCTime
    t <- IO UTCTime
    getCurrentTime
      TimeZone
    tz <- IO TimeZone
    getCurrentTimeZone
      ZonedTime -> IO ZonedTime
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ZonedTime -> IO ZonedTime) -> ZonedTime -> IO ZonedTime
    forall a b. (a -> b) -> a -> b
    $ TimeZone -> UTCTime -> ZonedTime
    utcToZonedTime TimeZone
    tz UTCTime
    t