{-# LANGUAGE TupleSections #-}
module Hcompta.CLI.Command where
-import Data.Maybe (fromMaybe)
+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 (exitWith, ExitCode(..))
+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 Hcompta.CLI.Context (Context)
-import qualified Hcompta.CLI.Context as Context
+-- 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 Hcompta.Lib.Leijen ((<>))
-import qualified Hcompta.Lib.Leijen as W
-usage :: IO String
-usage = do
+usage :: C.Context -> IO String
+usage c = do
bin <- getProgName
- return $ unlines $
- [ "SYNTAX "
- , " "++bin++" [option..] <command> [arguments]"
- , ""
- , usageInfo "OPTIONS" options
- , "COMMANDS (use "++bin++" <command> --help for specific help)"
- , " journal [-i FILE] [-t TRANSACTION_FILTER] [-p POSTING_FILTER]"
- , " balance [-i FILE] [-t TRANSACTION_FILTER] [-p POSTING_FILTER] BALANCE_FILTER"
- , " gl [-i FILE] [-t TRANSACTION_FILTER] [-p POSTING_FILTER] GL_FILTER"
- ]
+ 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 :: Args.Options Context
-options =
+options :: C.Context -> Args.Options C.Context
+options ctx =
[ Option "h" ["help"]
- (NoArg (\_opts _context -> do
- usage >>= IO.hPutStr IO.stderr
- exitWith ExitSuccess))
- "show this help"
+ (NoArg (\_opts -> do
+ usage ctx >>= IO.hPutStr IO.stderr
+ exitSuccess)) $
+ C.translate ctx Lang.Help_Option_Help
, Option "v" ["verbosity"]
- (OptArg (\arg _context context ->
+ (OptArg (\arg c ->
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"
+ 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 _context context -> do
+ (OptArg (\arg c -> do
color <- case arg of
- Nothing -> return $ Just True
- Just "always" -> return $ Just True
- Just "never" -> return $ Just False
- Just "auto" -> return $ Nothing
- Just _ -> Write.fatal context $
- W.text "--color option expects \"always\", \"auto\", or \"never\" as value"
- return $ context{Context.color})
- "[always|auto|never]")
- "colorize output"
+ 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 _context context -> do
- return $ context{Context.lang =
- fromMaybe (Context.lang context) $
- Lang.lang_of_strings [lang]
+ (ReqArg (\lang c ->
+ return $ c{C.lang =
+ fromMaybe (C.lang c) $
+ Lang.from_Strings [lang]
})
- "[xx|xx-XX]")
- "RFC1766 / ISO 639-1 language code (eg, fr, en-GB, etc.)"
+ "[xx|xx-XX]") $
+ C.translate ctx Lang.Help_Option_Lang
]
-run :: Context -> String -> [String] -> IO ()
-run context cmd args =
+run :: C.Context -> String -> [String] -> IO ()
+run c 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) <>) .
+ -- "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
sourcephile / git / comptalang.git / blobdiff