]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/CLI/Command.hs
Ajout : Lib.TreeMap.Zipper : en prévision de collectes « à la XSLT » sur Chart.
[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
23 import qualified Hcompta.CLI.Args as Args
24 import qualified Hcompta.CLI.Command.Balance as Command.Balance
25 import qualified Hcompta.CLI.Command.GL as Command.GL
26 import qualified Hcompta.CLI.Command.Journal as Command.Journal
27 import qualified Hcompta.CLI.Command.Journals as Command.Journals
28 import qualified Hcompta.CLI.Command.Stats as Command.Stats
29 -- import qualified Hcompta.CLI.Command.Tags as Command.Tags
30 import qualified Hcompta.CLI.Context as C
31 import qualified Hcompta.CLI.Lang as Lang
32 import qualified Hcompta.CLI.Write as Write
33 import qualified Hcompta.Lib.Leijen as W
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 -> do
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