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