]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/CLI/Command.hs
Correction : compatiblité avec GHC-7.6 en limitant l’usage de Prelude.
[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 Hcompta.CLI.Context (Context)
31 import qualified Hcompta.CLI.Context as Context
32 import qualified Hcompta.CLI.Lang as Lang
33 import qualified Hcompta.CLI.Write as Write
34 import qualified Hcompta.Lib.Leijen as W
35
36 usage :: IO String
37 usage = do
38 bin <- getProgName
39 return $ unlines $
40 [ "SYNTAX "
41 , " "++bin++" [option..] <command> [arguments]"
42 , ""
43 , usageInfo "OPTIONS" options
44 , "COMMANDS (use "++bin++" <command> --help for specific help)"
45 , " balance [-i JOURNAL_FILE]"
46 , " [-b BALANCE_FILTER]"
47 , " [-p POSTING_FILTER]"
48 , " [-t TRANSACTION_FILTER]"
49 , " [JOURNAL_FILE] [...]"
50 , " gl [-i JOURNAL_FILE]"
51 , " [-g GL_FILTER]"
52 , " [-p POSTING_FILTER]"
53 , " [-t TRANSACTION_FILTER]"
54 , " [JOURNAL_FILE] [...]"
55 , " journal [-i JOURNAL_FILE]"
56 , " [-t TRANSACTION_FILTER]"
57 , " [JOURNAL_FILE] [...]"
58 , " journals [-i JOURNAL_FILE]"
59 , " [JOURNAL_FILE] [...]"
60 , " stats [-i JOURNAL_FILE]"
61 , " [-t TRANSACTION_FILTER]"
62 , " [JOURNAL_FILE] [...]"
63 , " tags [-i JOURNAL_FILE]"
64 , " [-t TRANSACTION_FILTER]"
65 , " [JOURNAL_FILE] [...]"
66 ]
67
68 options :: Args.Options Context
69 options =
70 [ Option "h" ["help"]
71 (NoArg (\_opts _context -> do
72 usage >>= IO.hPutStr IO.stderr
73 exitSuccess))
74 "show this help"
75 , Option "v" ["verbosity"]
76 (OptArg (\arg _context context ->
77 case arg of
78 Nothing ->
79 case Context.verbosity context of
80 v | v < maxBound ->
81 return $ context{Context.verbosity=succ v}
82 _ -> return $ context
83 Just "error" -> return $ context{Context.verbosity=Context.Verbosity_Error}
84 Just "warn" -> return $ context{Context.verbosity=Context.Verbosity_Warn}
85 Just "info" -> return $ context{Context.verbosity=Context.Verbosity_Info}
86 Just "debug" -> return $ context{Context.verbosity=Context.Verbosity_Debug}
87 Just _ -> Write.fatal context $
88 W.text "--verbosity option expects \"error\", \"warn\", \"info\", or \"debug\" as value")
89 "error|warn|info|debug"
90 )
91 "increment or set verbosity level, can be use multiple times"
92 , Option "" ["color"]
93 (OptArg (\arg _context context -> do
94 color <- case arg of
95 Nothing -> return $ Just True
96 Just "yes" -> return $ Just True
97 Just "no" -> return $ Just False
98 Just "auto" -> return $ Nothing
99 Just _ -> Write.fatal context $
100 W.text "--color option expects \"auto\" (default), \"yes\", or \"no\" as value"
101 return $ context{Context.color})
102 "[auto|yes|no]")
103 "colorize output"
104 , Option "" ["lang"]
105 (ReqArg (\lang _context context -> do
106 return $ context{Context.lang =
107 fromMaybe (Context.lang context) $
108 Lang.lang_of_strings [lang]
109 })
110 "[xx|xx-XX]")
111 "RFC1766 / ISO 639-1 language code (eg, fr, en-GB, etc.)"
112 ]
113
114 run :: Context -> String -> [String] -> IO ()
115 run context cmd args =
116 case cmd of
117 "balance" -> Command.Balance.run context args
118 "gl" -> Command.GL.run context args
119 "journal" -> Command.Journal.run context args
120 "journals" -> Command.Journals.run context args
121 "stats" -> Command.Stats.run context args
122 "tags" -> Command.Tags.run context args
123 _ -> usage >>= Write.fatal context .
124 ((W.text "unknown command: " <> (W.text $ TL.pack cmd) <> W.line) <>) .
125 W.text . TL.pack