cli/Hcompta/CLI/Command.hs

   1 {-# LANGUAGE NamedFieldPuns #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE TupleSections #-}
   4 module Hcompta.CLI.Command where
   5
   6 import           Data.Maybe (fromMaybe)
   7 import qualified Data.Text.Lazy as TL
   8 import           System.Console.GetOpt
   9                  ( ArgDescr(..)
  10                  , OptDescr(..)
  11                  , usageInfo )
  12 import           System.Environment (getProgName)
  13 import           System.Exit (exitWith, ExitCode(..))
  14 import qualified System.IO as IO
  15
  16 import qualified Hcompta.CLI.Args as Args
  17 import qualified Hcompta.CLI.Command.Balance as Command.Balance
  18 import qualified Hcompta.CLI.Command.GL as Command.GL
  19 import qualified Hcompta.CLI.Command.Journal as Command.Journal
  20 import           Hcompta.CLI.Context (Context)
  21 import qualified Hcompta.CLI.Context as Context
  22 import qualified Hcompta.CLI.Lang as Lang
  23 import qualified Hcompta.CLI.Write as Write
  24 import           Hcompta.Lib.Leijen ((<>))
  25 import qualified Hcompta.Lib.Leijen as W
  26
  27 usage :: IO String
  28 usage = do
  29         bin <- getProgName
  30         return $ unlines $
  31                 [ "SYNTAX "
  32                 , "  "++bin++" [option..] <command> [arguments]"
  33                 , ""
  34                 , usageInfo "OPTIONS" options
  35                 , "COMMANDS (use "++bin++" <command> --help for specific help)"
  36                 , "  journal [-i JOURNAL_FILE]"
  37                 , "          [-t TRANSACTION_FILTER]"
  38                 , "          [JOURNAL_FILE] [...]"
  39                 , "  balance [-i JOURNAL_FILE]"
  40                 , "          [-b BALANCE_FILTER]"
  41                 , "          [-p POSTING_FILTER]"
  42                 , "          [-t TRANSACTION_FILTER]"
  43                 , "          [JOURNAL_FILE] [...]"
  44                 , "  gl      [-i JOURNAL_FILE]"
  45                 , "          [-g GL_FILTER]"
  46                 , "          [-p POSTING_FILTER]"
  47                 , "          [-t TRANSACTION_FILTER]"
  48                 , "          [JOURNAL_FILE] [...]"
  49                 ]
  50
  51 options :: Args.Options Context
  52 options =
  53         [ Option "h" ["help"]
  54          (NoArg (\_opts _context -> do
  55                 usage >>= IO.hPutStr IO.stderr
  56                 exitWith ExitSuccess))
  57          "show this help"
  58         , Option "v" ["verbosity"]
  59          (OptArg (\arg _context context ->
  60                 case arg of
  61                  Nothing      ->
  62                         case Context.verbosity context of
  63                          v | v < maxBound ->
  64                                 return $ context{Context.verbosity=succ v}
  65                          _ -> return $ context
  66                  Just "error" -> return $ context{Context.verbosity=Context.Verbosity_Error}
  67                  Just "warn"  -> return $ context{Context.verbosity=Context.Verbosity_Warn}
  68                  Just "info"  -> return $ context{Context.verbosity=Context.Verbosity_Info}
  69                  Just "debug" -> return $ context{Context.verbosity=Context.Verbosity_Debug}
  70                  Just _       -> Write.fatal context $
  71                         W.text "--verbosity option expects \"error\", \"warn\", \"info\", or \"debug\" as value")
  72                 "error|warn|info|debug"
  73                 )
  74          "increment or set verbosity level, can be use multiple times"
  75         , Option "" ["color"]
  76          (OptArg (\arg _context context -> do
  77                 color <- case arg of
  78                  Nothing     -> return $ Just True
  79                  Just "yes"  -> return $ Just True
  80                  Just "no"   -> return $ Just False
  81                  Just "auto" -> return $ Nothing
  82                  Just _      -> Write.fatal context $
  83                         W.text "--color option expects \"auto\" (default), \"yes\", or \"no\" as value"
  84                 return $ context{Context.color})
  85           "[auto|yes|no]")
  86          "colorize output"
  87         , Option "" ["lang"]
  88          (ReqArg (\lang _context context -> do
  89                 return $ context{Context.lang =
  90                         fromMaybe (Context.lang context) $
  91                         Lang.lang_of_strings [lang]
  92                  })
  93           "[xx|xx-XX]")
  94          "RFC1766 / ISO 639-1 language code (eg, fr, en-GB, etc.)"
  95         ]
  96
  97 run :: Context -> String -> [String] -> IO ()
  98 run context cmd args =
  99         case cmd of
 100          "balance" -> Command.Balance.run context args
 101          "gl"      -> Command.GL.run      context args
 102          "journal" -> Command.Journal.run context args
 103          _ -> usage >>= Write.fatal context .
 104                 ((W.text "unknown command: " <> (W.text $ TL.pack cmd) <> W.line) <>) .
 105                 W.text . TL.pack