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 import qualified Text.WalderLeijen.ANSI.Text as W
  23
  24 import qualified Hcompta.CLI.Args as Args
  25 -- import qualified Hcompta.CLI.Command.Balance as Command.Balance
  26 -- import qualified Hcompta.CLI.Command.GL as Command.GL
  27 -- import qualified Hcompta.CLI.Command.Journal as Command.Journal
  28 import qualified Hcompta.CLI.Command.Journals as Command.Journals
  29 -- import qualified Hcompta.CLI.Command.Stats as Command.Stats
  30 -- import qualified Hcompta.CLI.Command.Tags as Command.Tags
  31 import qualified Hcompta.CLI.Context as C
  32 import qualified Hcompta.CLI.Lang as Lang
  33 import qualified Hcompta.CLI.Write as Write
  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 ->
  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