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 qualified Hcompta.CLI.Context as C
  31 import qualified Hcompta.CLI.Lang as Lang
  32 import qualified Hcompta.CLI.Write as Write
  33 import qualified Hcompta.Lib.Leijen as W
  34
  35 usage :: C.Context -> IO String
  36 usage c = do
  37         bin <- getProgName
  38         return $ unlines $
  39                 [ C.translate c Lang.Section_Syntax
  40                 , "  "++bin++" "++C.translate c Lang.Help_Synopsis
  41                 , ""
  42                 , usageInfo (C.translate c Lang.Section_Options) (options c)
  43                 , C.translate c Lang.Section_Commands
  44                 , "  [bal|balance]       "++C.translate c Lang.Help_Command_Balance
  45                 , "  [gl|general_ledger] "++C.translate c Lang.Help_Command_General_Ledger
  46                 , "  [j|journal]         "++C.translate c Lang.Help_Command_Journal
  47                 , "  [js|journals]       "++C.translate c Lang.Help_Command_Journals
  48                 , "  stats               "++C.translate c Lang.Help_Command_Stats
  49                 , "  tags                "++C.translate c Lang.Help_Command_Tags
  50                 ]
  51
  52 options :: C.Context -> Args.Options C.Context
  53 options ctx =
  54         [ Option "h" ["help"]
  55          (NoArg (\_opts -> do
  56                 usage ctx >>= IO.hPutStr IO.stderr
  57                 exitSuccess)) $
  58                 C.translate ctx Lang.Help_Option_Help
  59         , Option "v" ["verbosity"]
  60          (OptArg (\arg c ->
  61                 case arg of
  62                  Nothing ->
  63                         case C.verbosity c of
  64                          v | v < maxBound -> return $ c{C.verbosity=succ v}
  65                          _                -> return $ c
  66                  Just "error" -> return $ c{C.verbosity=C.Verbosity_Error}
  67                  Just "warn"  -> return $ c{C.verbosity=C.Verbosity_Warn}
  68                  Just "info"  -> return $ c{C.verbosity=C.Verbosity_Info}
  69                  Just "debug" -> return $ c{C.verbosity=C.Verbosity_Debug}
  70                  Just _       -> Write.fatal c Lang.Error_Option_Verbosity)
  71                 "error|warn|info|debug") $
  72                 C.translate ctx Lang.Help_Option_Verbosity
  73         , Option "" ["color"]
  74          (OptArg (\arg c -> do
  75                 color <- case arg of
  76                  Nothing     -> return $ Just True
  77                  Just "yes"  -> return $ Just True
  78                  Just "no"   -> return $ Just False
  79                  Just "auto" -> return $ Nothing
  80                  Just _      -> Write.fatal c Lang.Error_Option_Color
  81                 return $ c{C.color})
  82           "[auto|yes|no]") $
  83                 C.translate ctx Lang.Help_Option_Color
  84         , Option "" ["lang"]
  85          (ReqArg (\lang c -> do
  86                 return $ c{C.lang =
  87                         fromMaybe (C.lang c) $
  88                         Lang.from_Strings [lang]
  89                  })
  90           "[xx|xx-XX]") $
  91                 C.translate ctx Lang.Help_Option_Lang
  92         ]
  93
  94 run :: C.Context -> String -> [String] -> IO ()
  95 run c cmd args =
  96         case cmd of
  97          "bal"            -> Command.Balance.run  c args
  98          "balance"        -> Command.Balance.run  c args
  99          "gl"             -> Command.GL.run       c args
 100          "general_ledger" -> Command.GL.run       c args
 101          "j"              -> Command.Journal.run  c args
 102          "journal"        -> Command.Journal.run  c args
 103          "js"             -> Command.Journals.run c args
 104          "journals"       -> Command.Journals.run c args
 105          "stats"          -> Command.Stats.run    c args
 106          -- "tags"           -> Command.Tags.run     c args
 107          _ -> usage c >>= Write.fatal c .
 108                 ((C.translate c (Lang.Error_Unkown_command cmd) <> W.line) <>) .
 109                 W.text . TL.pack