]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/CLI/Write.hs
Correction : Lib.Parsec : détection et propagation des erreurs.
[comptalang.git] / 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