{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Hcompta.CLI.Command where

import           Control.Monad (Monad(..))
import           Data.Bool
import           Data.List ((++))
import           Data.Maybe (Maybe(..), fromMaybe)
import           Data.Monoid ((<>))
import           Data.Ord (Ord(..))
import           Data.String (String)
import qualified Data.Text.Lazy as TL
import           Prelude (($), (.), Bounded(..), Enum(..), IO, unlines)
import           System.Console.GetOpt
                 ( ArgDescr(..)
                 , OptDescr(..)
                 , usageInfo )
import           System.Environment (getProgName)
import           System.Exit (exitSuccess)
import qualified System.IO as IO
import qualified Text.WalderLeijen.ANSI.Text as W

import qualified Hcompta.CLI.Args as Args
-- import qualified Hcompta.CLI.Command.Balance as Command.Balance
-- import qualified Hcompta.CLI.Command.GL as Command.GL
-- import qualified Hcompta.CLI.Command.Journal as Command.Journal
import qualified Hcompta.CLI.Command.Journals as Command.Journals
-- import qualified Hcompta.CLI.Command.Stats as Command.Stats
-- import qualified Hcompta.CLI.Command.Tags as Command.Tags
import qualified Hcompta.CLI.Context as C
import qualified Hcompta.CLI.Lang as Lang
import qualified Hcompta.CLI.Write as Write

usage :: C.Context -> IO String
usage c = do
	bin <- getProgName
	return $ unlines
	 [ C.translate c Lang.Section_Syntax
	 , "  "++bin++" "++C.translate c Lang.Help_Synopsis
	 , ""
	 , usageInfo (C.translate c Lang.Section_Options) (options c)
	 , C.translate c Lang.Section_Commands
	 , "  [bal|balance]       "++C.translate c Lang.Help_Command_Balance
	 , "  [gl|general_ledger] "++C.translate c Lang.Help_Command_General_Ledger
	 , "  [j|journal]         "++C.translate c Lang.Help_Command_Journal
	 , "  [js|journals]       "++C.translate c Lang.Help_Command_Journals
	 , "  stats               "++C.translate c Lang.Help_Command_Stats
	 , "  tags                "++C.translate c Lang.Help_Command_Tags
	 ]

options :: C.Context -> Args.Options C.Context
options ctx =
	[ Option "h" ["help"]
	 (NoArg (\_opts -> do
		usage ctx >>= IO.hPutStr IO.stderr
		exitSuccess)) $
		C.translate ctx Lang.Help_Option_Help
	, Option "v" ["verbosity"]
	 (OptArg (\arg c ->
		case arg of
		 Nothing ->
			case C.verbosity c of
			 v | v < maxBound -> return $ c{C.verbosity=succ v}
			 _                -> return $ c
		 Just "error" -> return $ c{C.verbosity=C.Verbosity_Error}
		 Just "warn"  -> return $ c{C.verbosity=C.Verbosity_Warn}
		 Just "info"  -> return $ c{C.verbosity=C.Verbosity_Info}
		 Just "debug" -> return $ c{C.verbosity=C.Verbosity_Debug}
		 Just _       -> Write.fatal c Lang.Error_Option_Verbosity)
		"error|warn|info|debug") $
		C.translate ctx Lang.Help_Option_Verbosity
	, Option "" ["color"]
	 (OptArg (\arg c -> do
		color <- case arg of
		 Nothing     -> return $ Just True
		 Just "yes"  -> return $ Just True
		 Just "no"   -> return $ Just False
		 Just "auto" -> return $ Nothing
		 Just _      -> Write.fatal c Lang.Error_Option_Color
		return $ c{C.color})
	  "[auto|yes|no]") $
		C.translate ctx Lang.Help_Option_Color
	, Option "" ["lang"]
	 (ReqArg (\lang c ->
		return $ c{C.lang =
			fromMaybe (C.lang c) $
			Lang.from_Strings [lang]
		 })
	  "[xx|xx-XX]") $
		C.translate ctx Lang.Help_Option_Lang
	]

run :: C.Context -> String -> [String] -> IO ()
run c cmd args =
	case cmd of
	 -- "bal"            -> Command.Balance.run  c args
	 -- "balance"        -> Command.Balance.run  c args
	 -- "gl"             -> Command.GL.run       c args
	 -- "general_ledger" -> Command.GL.run       c args
	 -- "j"              -> Command.Journal.run  c args
	 -- "journal"        -> Command.Journal.run  c args
	 -- "js"             -> Command.Journals.run c args
	 "journals"       -> Command.Journals.run c args
	 -- "stats"          -> Command.Stats.run    c args
	 -- "tags"           -> Command.Tags.run     c args
	 _ -> usage c >>= Write.fatal c .
		((C.translate c (Lang.Error_Unkown_command cmd) <> W.line) <>) .
		W.text . TL.pack