cli/Hcompta/CLI/Write.hs

   1 module Hcompta.CLI.Write where
   2
   3 import           Control.Monad (when)
   4 import qualified System.IO as IO
   5 import qualified System.Console.ANSI as ANSI
   6 import           System.Exit (exitWith, ExitCode(..))
   7
   8 import qualified Hcompta.CLI.Context as Context
   9 import           Hcompta.CLI.Context (Context)
  10
  11 with_color :: Context -> IO.Handle -> IO Bool
  12 with_color context h =
  13         case Context.color context of
  14          Nothing -> IO.hIsTerminalDevice h
  15          Just b -> return b
  16
  17 debug :: Context -> String -> IO ()
  18 debug context msg = do
  19         case Context.verbosity context of
  20          v | v >= Context.Verbosity_Debug -> do
  21                 color <- with_color context IO.stderr
  22                 when color $
  23                         ANSI.hSetSGR IO.stderr [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Magenta]
  24                 IO.hPutStr IO.stderr "DEBUG"
  25                 when color $
  26                         ANSI.hSetSGR IO.stderr [ANSI.Reset]
  27                 IO.hPutStr IO.stderr $ concat [": ", msg, "\n"]
  28          _ -> return ()
  29
  30 error :: Context -> String -> IO ()
  31 error context msg = do
  32         case Context.verbosity context of
  33          v | v >= Context.Verbosity_Error -> do
  34                 color <- with_color context IO.stderr
  35                 when color $
  36                         ANSI.hSetSGR IO.stderr [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Red]
  37                 IO.hPutStr IO.stderr "ERROR"
  38                 when color $
  39                         ANSI.hSetSGR IO.stderr [ANSI.Reset]
  40                 IO.hPutStr IO.stderr $ concat [": ", msg, "\n"]
  41          _ -> return ()
  42
  43 fatal :: Context -> String -> IO a
  44 fatal context msg = do
  45         Hcompta.CLI.Write.error context msg
  46         exitWith $ ExitFailure 1