{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.CLI.Write where

import           Control.Monad (Monad(..), when)
import           Data.Bool
import           Data.List (concat)
import           Data.Maybe (Maybe(..))
import           Data.Ord (Ord(..))
import           Data.String (String)
import           Prelude (($), IO)
import qualified System.Console.ANSI as ANSI
import           System.Exit (exitWith, ExitCode(..))
import qualified System.IO as IO

import           Hcompta.CLI.Context (Context)
import qualified Hcompta.CLI.Context as Context
import           Hcompta.CLI.Lang (Lang)
import qualified Hcompta.CLI.Lang as Lang
import           Hcompta.Lib.Leijen ((<>), ToDoc(..))
import qualified Hcompta.Lib.Leijen as W

with_color :: Context -> IO.Handle -> IO Bool
with_color context h =
	case Context.color context of
	 Nothing -> IO.hIsTerminalDevice h
	 Just b -> return b

debug :: Context -> String -> IO ()
debug context msg = do
	case Context.verbosity context of
	 v | v >= Context.Verbosity_Debug -> do
		color <- with_color context IO.stderr
		when color $
			ANSI.hSetSGR IO.stderr [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Magenta]
		IO.hPutStr IO.stderr "DEBUG"
		when color $
			ANSI.hSetSGR IO.stderr [ANSI.Reset]
		IO.hPutStr IO.stderr $ concat [": ", msg, "\n"]
	 _ -> return ()

error :: ToDoc Lang d => Context -> d -> IO ()
error context msg = do
	case Context.verbosity context of
	 v | v >= Context.Verbosity_Error -> do
		color <- with_color context IO.stderr
		when color $
			ANSI.hSetSGR IO.stderr
			 [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Red]
		W.hPutDoc IO.stderr $
			toDoc (Context.lang context) Lang.Message_ERROR
		when color $
			ANSI.hSetSGR IO.stderr [ANSI.Reset]
		let doc = toDoc (Context.lang context) msg
		W.hPutDoc IO.stderr $
			W.string ":" <> W.space <> doc <> W.line
	 _ -> return ()

fatal :: ToDoc Lang d => Context -> d -> IO a
fatal context msg = do
	Hcompta.CLI.Write.error context msg
	exitWith $ ExitFailure 1