{-# 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 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
import qualified Hcompta.Lib.Leijen as W

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