]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/CLI/Command.hs
Refactor hcompta-lib.
[comptalang.git] / cli / Hcompta / CLI / Command.hs
1 {-# LANGUAGE NamedFieldPuns #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE TupleSections #-}
4 module Hcompta.CLI.Command where
5
6 import Control.Monad (Monad(..))
7 import Data.Bool
8 import Data.List ((++))
9 import Data.Maybe (Maybe(..), fromMaybe)
10 import Data.Monoid ((<>))
11 import Data.Ord (Ord(..))
12 import Data.String (String)
13 import qualified Data.Text.Lazy as TL
14 import Prelude (($), (.), Bounded(..), Enum(..), IO, unlines)
15 import System.Console.GetOpt
16 ( ArgDescr(..)
17 , OptDescr(..)
18 , usageInfo )
19 import System.Environment (getProgName)
20 import System.Exit (exitSuccess)
21 import qualified System.IO as IO
22 import qualified Text.WalderLeijen.ANSI.Text as W
23
24 import qualified Hcompta.CLI.Args as Args
25 -- import qualified Hcompta.CLI.Command.Balance as Command.Balance
26 -- import qualified Hcompta.CLI.Command.GL as Command.GL
27 -- import qualified Hcompta.CLI.Command.Journal as Command.Journal
28 import qualified Hcompta.CLI.Command.Journals as Command.Journals
29 -- import qualified Hcompta.CLI.Command.Stats as Command.Stats
30 -- import qualified Hcompta.CLI.Command.Tags as Command.Tags
31 import qualified Hcompta.CLI.Context as C
32 import qualified Hcompta.CLI.Lang as Lang
33 import qualified Hcompta.CLI.Write as Write
34
35 usage :: C.Context -> IO String
36 usage c = do
37 bin <- getProgName
38 return $ unlines
39 [ C.translate c Lang.Section_Syntax
40 , " "++bin++" "++C.translate c Lang.Help_Synopsis
41 , ""
42 , usageInfo (C.translate c Lang.Section_Options) (options c)
43 , C.translate c Lang.Section_Commands
44 , " [bal|balance] "++C.translate c Lang.Help_Command_Balance
45 , " [gl|general_ledger] "++C.translate c Lang.Help_Command_General_Ledger
46 , " [j|journal] "++C.translate c Lang.Help_Command_Journal
47 , " [js|journals] "++C.translate c Lang.Help_Command_Journals
48 , " stats "++C.translate c Lang.Help_Command_Stats
49 , " tags "++C.translate c Lang.Help_Command_Tags
50 ]
51
52 options :: C.Context -> Args.Options C.Context
53 options ctx =
54 [ Option "h" ["help"]
55 (NoArg (\_opts -> do
56 usage ctx >>= IO.hPutStr IO.stderr
57 exitSuccess)) $
58 C.translate ctx Lang.Help_Option_Help
59 , Option "v" ["verbosity"]
60 (OptArg (\arg c ->
61 case arg of
62 Nothing ->
63 case C.verbosity c of
64 v | v < maxBound -> return $ c{C.verbosity=succ v}
65 _ -> return $ c
66 Just "error" -> return $ c{C.verbosity=C.Verbosity_Error}
67 Just "warn" -> return $ c{C.verbosity=C.Verbosity_Warn}
68 Just "info" -> return $ c{C.verbosity=C.Verbosity_Info}
69 Just "debug" -> return $ c{C.verbosity=C.Verbosity_Debug}
70 Just _ -> Write.fatal c Lang.Error_Option_Verbosity)
71 "error|warn|info|debug") $
72 C.translate ctx Lang.Help_Option_Verbosity
73 , Option "" ["color"]
74 (OptArg (\arg c -> do
75 color <- case arg of
76 Nothing -> return $ Just True
77 Just "yes" -> return $ Just True
78 Just "no" -> return $ Just False
79 Just "auto" -> return $ Nothing
80 Just _ -> Write.fatal c Lang.Error_Option_Color
81 return $ c{C.color})
82 "[auto|yes|no]") $
83 C.translate ctx Lang.Help_Option_Color
84 , Option "" ["lang"]
85 (ReqArg (\lang c ->
86 return $ c{C.lang =
87 fromMaybe (C.lang c) $
88 Lang.from_Strings [lang]
89 })
90 "[xx|xx-XX]") $
91 C.translate ctx Lang.Help_Option_Lang
92 ]
93
94 run :: C.Context -> String -> [String] -> IO ()
95 run c cmd args =
96 case cmd of
97 -- "bal" -> Command.Balance.run c args
98 -- "balance" -> Command.Balance.run c args
99 -- "gl" -> Command.GL.run c args
100 -- "general_ledger" -> Command.GL.run c args
101 -- "j" -> Command.Journal.run c args
102 -- "journal" -> Command.Journal.run c args
103 -- "js" -> Command.Journals.run c args
104 "journals" -> Command.Journals.run c args
105 -- "stats" -> Command.Stats.run c args
106 -- "tags" -> Command.Tags.run c args
107 _ -> usage c >>= Write.fatal c .
108 ((C.translate c (Lang.Error_Unkown_command cmd) <> W.line) <>) .
109 W.text . TL.pack