{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} module Hcompta.CLI.Command where import Data.Maybe (fromMaybe) import qualified Data.Text.Lazy as TL 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 Hcompta.CLI.Context (Context) import qualified Hcompta.CLI.Context as Context import qualified Hcompta.CLI.Lang as Lang import qualified Hcompta.CLI.Write as Write import Hcompta.Lib.Leijen ((<>)) import qualified Hcompta.Lib.Leijen as W usage :: IO String usage = do bin <- getProgName return $ unlines $ [ "SYNTAX " , " "++bin++" [option..] [arguments]" , "" , usageInfo "OPTIONS" options , "COMMANDS (use "++bin++" --help for specific help)" , " journal [-i JOURNAL_FILE]" , " [-t TRANSACTION_FILTER]" , " [JOURNAL_FILE] [...]" , " balance [-i JOURNAL_FILE]" , " [-b BALANCE_FILTER]" , " [-p POSTING_FILTER]" , " [-t TRANSACTION_FILTER]" , " [JOURNAL_FILE] [...]" , " gl [-i JOURNAL_FILE]" , " [-g GL_FILTER]" , " [-p POSTING_FILTER]" , " [-t TRANSACTION_FILTER]" , " [JOURNAL_FILE] [...]" ] options :: Args.Options Context options = [ Option "h" ["help"] (NoArg (\_opts _context -> do usage >>= IO.hPutStr IO.stderr exitSuccess)) "show this help" , Option "v" ["verbosity"] (OptArg (\arg _context context -> case arg of Nothing -> case Context.verbosity context of v | v < maxBound -> return $ context{Context.verbosity=succ v} _ -> return $ context Just "error" -> return $ context{Context.verbosity=Context.Verbosity_Error} Just "warn" -> return $ context{Context.verbosity=Context.Verbosity_Warn} Just "info" -> return $ context{Context.verbosity=Context.Verbosity_Info} Just "debug" -> return $ context{Context.verbosity=Context.Verbosity_Debug} Just _ -> Write.fatal context $ W.text "--verbosity option expects \"error\", \"warn\", \"info\", or \"debug\" as value") "error|warn|info|debug" ) "increment or set verbosity level, can be use multiple times" , Option "" ["color"] (OptArg (\arg _context context -> 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 context $ W.text "--color option expects \"auto\" (default), \"yes\", or \"no\" as value" return $ context{Context.color}) "[auto|yes|no]") "colorize output" , Option "" ["lang"] (ReqArg (\lang _context context -> do return $ context{Context.lang = fromMaybe (Context.lang context) $ Lang.lang_of_strings [lang] }) "[xx|xx-XX]") "RFC1766 / ISO 639-1 language code (eg, fr, en-GB, etc.)" ] run :: Context -> String -> [String] -> IO () run context cmd args = case cmd of "balance" -> Command.Balance.run context args "gl" -> Command.GL.run context args "journal" -> Command.Journal.run context args _ -> usage >>= Write.fatal context . ((W.text "unknown command: " <> (W.text $ TL.pack cmd) <> W.line) <>) . W.text . TL.pack