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 FILE_JOURNAL]"
  46                 , "           [-b FILTER_BALANCE]"
  47                 , "           [-p FILTER_POSTING]"
  48                 , "           [-t FILTER_TRANSACTION]"
  49                 , "           [FILE_JOURNAL] [...]"
  50                 , "  gl       [-i FILE_JOURNAL]"
  51                 , "           [-g FILTER_GL]"
  52                 , "           [-p FILTER_POSTING]"
  53                 , "           [-t FILTER_TRANSACTION]"
  54                 , "           [FILE_JOURNAL] [...]"
  55                 , "  journal  [-i FILE_JOURNAL]"
  56                 , "           [-t FILTER_TRANSACTION]"
  57                 , "           [FILE_JOURNAL] [...]"
  58                 , "  journals [-i FILE_JOURNAL]"
  59                 , "           [FILE_JOURNAL] [...]"
  60                 , "  stats    [-i FILE_JOURNAL]"
  61                 , "           [-t FILTER_TRANSACTION]"
  62                 , "           [FILE_JOURNAL] [...]"
  63                 , "  tags     [-i FILE_JOURNAL]"
  64                 , "           [-t FILTER_TRANSACTION]"
  65                 , "           [-T FILTER_TAG]"
  66                 , "           [FILE_JOURNAL] [...]"
  67                 ]
  68
  69 options :: Args.Options Context
  70 options =
  71         [ Option "h" ["help"]
  72          (NoArg (\_opts _context -> do
  73                 usage >>= IO.hPutStr IO.stderr
  74                 exitSuccess))
  75          "show this help"
  76         , Option "v" ["verbosity"]
  77          (OptArg (\arg _context context ->
  78                 case arg of
  79                  Nothing      ->
  80                         case Context.verbosity context of
  81                          v | v < maxBound ->
  82                                 return $ context{Context.verbosity=succ v}
  83                          _ -> return $ context
  84                  Just "error" -> return $ context{Context.verbosity=Context.Verbosity_Error}
  85                  Just "warn"  -> return $ context{Context.verbosity=Context.Verbosity_Warn}
  86                  Just "info"  -> return $ context{Context.verbosity=Context.Verbosity_Info}
  87                  Just "debug" -> return $ context{Context.verbosity=Context.Verbosity_Debug}
  88                  Just _       -> Write.fatal context $
  89                         W.text "--verbosity option expects \"error\", \"warn\", \"info\", or \"debug\" as value")
  90                 "error|warn|info|debug"
  91                 )
  92          "increment or set verbosity level, can be use multiple times"
  93         , Option "" ["color"]
  94          (OptArg (\arg _context context -> do
  95                 color <- case arg of
  96                  Nothing     -> return $ Just True
  97                  Just "yes"  -> return $ Just True
  98                  Just "no"   -> return $ Just False
  99                  Just "auto" -> return $ Nothing
 100                  Just _      -> Write.fatal context $
 101                         W.text "--color option expects \"auto\" (default), \"yes\", or \"no\" as value"
 102                 return $ context{Context.color})
 103           "[auto|yes|no]")
 104          "colorize output"
 105         , Option "" ["lang"]
 106          (ReqArg (\lang _context context -> do
 107                 return $ context{Context.lang =
 108                         fromMaybe (Context.lang context) $
 109                         Lang.lang_of_strings [lang]
 110                  })
 111           "[xx|xx-XX]")
 112          "RFC1766 / ISO 639-1 language code (eg, fr, en-GB, etc.)"
 113         ]
 114
 115 run :: Context -> String -> [String] -> IO ()
 116 run context cmd args =
 117         case cmd of
 118          "balance"  -> Command.Balance.run  context args
 119          "gl"       -> Command.GL.run       context args
 120          "journal"  -> Command.Journal.run  context args
 121          "journals" -> Command.Journals.run context args
 122          "stats"    -> Command.Stats.run    context args
 123          "tags"     -> Command.Tags.run     context args
 124          _ -> usage >>= Write.fatal context .
 125                 ((W.text "unknown command: " <> (W.text $ TL.pack cmd) <> W.line) <>) .
 126                 W.text . TL.pack