]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/CLI/Command.hs
Correction : Lib.Parsec : détection et propagation des erreurs.
[comptalang.git] / cli / Hcompta / CLI / Command.hs
1 {-# LANGUAGE NamedFieldPuns #-}
2 {-# LANGUAGE TupleSections #-}
3 module Hcompta.CLI.Command where
4
5 import System.Console.GetOpt
6 ( ArgDescr(..)
7 , OptDescr(..)
8 , usageInfo )
9 import System.Environment (getProgName)
10 import System.Exit (exitWith, ExitCode(..))
11 import qualified System.IO as IO
12
13 import Hcompta.CLI.Context (Context)
14 import qualified Hcompta.CLI.Args as Args
15 import qualified Hcompta.CLI.Command.Balance as Command.Balance
16 import qualified Hcompta.CLI.Command.Print as Command.Print
17 import qualified Hcompta.CLI.Context as Context
18 import qualified Hcompta.CLI.Write as Write
19
20 usage :: IO String
21 usage = do
22 bin <- getProgName
23 return $ unlines $
24 [ "SYNTAX "
25 , " "++bin++" [option..] <command> [arguments]"
26 , ""
27 , usageInfo "OPTIONS" options
28 , "COMMANDS (use "++bin++" <command> --help for specific help)"
29 , " balance [-i FILE]"
30 , " print [-i FILE]"
31 ]
32
33 options :: Args.Options Context
34 options =
35 [ Option "h" ["help"]
36 (NoArg (\_opts _context -> do
37 usage >>= IO.hPutStr IO.stderr
38 exitWith ExitSuccess))
39 "show this help"
40 , Option "v" ["verbosity"]
41 (OptArg (\arg _context context ->
42 case arg of
43 Nothing ->
44 case Context.verbosity context of
45 v | v < maxBound ->
46 return $ context{Context.verbosity=succ v}
47 _ -> return $ context
48 Just "error" -> return $ context{Context.verbosity=Context.Verbosity_Error}
49 Just "warn" -> return $ context{Context.verbosity=Context.Verbosity_Warn}
50 Just "info" -> return $ context{Context.verbosity=Context.Verbosity_Info}
51 Just "debug" -> return $ context{Context.verbosity=Context.Verbosity_Debug}
52 Just _ -> Write.fatal context
53 "--verbosity option expects \"error\", \"warn\", \"info\", or \"debug\" as value")
54 "error|warn|info|debug"
55 )
56 "increment or set verbosity level, can be use multiple times"
57 , Option "" ["color"]
58 (OptArg (\arg _context context -> do
59 color <- case arg of
60 Nothing -> return $ Just True
61 Just "always" -> return $ Just True
62 Just "never" -> return $ Just False
63 Just "auto" -> return $ Nothing
64 Just _ -> Write.fatal context
65 "--color option expects \"always\", \"auto\", or \"never\" as value"
66 return $ context{Context.color})
67 "[always|auto|never]")
68 "colorize output"
69 ]
70
71 run :: Context -> String -> [String] -> IO ()
72 run context cmd args =
73 case cmd of
74 "print" -> Command.Print.run context args
75 "balance" -> Command.Balance.run context args
76 _ -> usage >>= Write.fatal context . (("unknown command: " ++ cmd ++ "\n") ++)