cli/Hcompta/CLI/Command.hs

   1 {-# LANGUAGE NamedFieldPuns #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE TupleSections #-}
   4 module Hcompta.CLI.Command where
   5
   6 import qualified Data.Text as Text
   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           Hcompta.CLI.Context (Context)
  17 import qualified Hcompta.CLI.Args as Args
  18 import qualified Hcompta.CLI.Command.Balance as Command.Balance
  19 import qualified Hcompta.CLI.Command.Print   as Command.Print
  20 import qualified Hcompta.CLI.Context as Context
  21 import qualified Hcompta.CLI.Write as Write
  22 import qualified Hcompta.Lib.Leijen as W
  23 import           Hcompta.Lib.Leijen ((<>))
  24
  25 usage :: IO String
  26 usage = do
  27         bin <- getProgName
  28         return $ unlines $
  29                 [ "SYNTAX "
  30                 , "  "++bin++" [option..] <command> [arguments]"
  31                 , ""
  32                 , usageInfo "OPTIONS" options
  33                 , "COMMANDS (use "++bin++" <command> --help for specific help)"
  34                 , "  balance [-i FILE]"
  35                 , "  print   [-i FILE]"
  36                 ]
  37
  38 options :: Args.Options Context
  39 options =
  40         [ Option "h" ["help"]
  41          (NoArg (\_opts _context -> do
  42                 usage >>= IO.hPutStr IO.stderr
  43                 exitWith ExitSuccess))
  44          "show this help"
  45         , Option "v" ["verbosity"]
  46          (OptArg (\arg _context context ->
  47                 case arg of
  48                  Nothing      ->
  49                         case Context.verbosity context of
  50                          v | v < maxBound ->
  51                                 return $ context{Context.verbosity=succ v}
  52                          _ -> return $ context
  53                  Just "error" -> return $ context{Context.verbosity=Context.Verbosity_Error}
  54                  Just "warn"  -> return $ context{Context.verbosity=Context.Verbosity_Warn}
  55                  Just "info"  -> return $ context{Context.verbosity=Context.Verbosity_Info}
  56                  Just "debug" -> return $ context{Context.verbosity=Context.Verbosity_Debug}
  57                  Just _       -> Write.fatal context $
  58                         W.text "--verbosity option expects \"error\", \"warn\", \"info\", or \"debug\" as value")
  59                 "error|warn|info|debug"
  60                 )
  61          "increment or set verbosity level, can be use multiple times"
  62         , Option "" ["color"]
  63          (OptArg (\arg _context context -> do
  64                 color <- case arg of
  65                  Nothing       -> return $ Just True
  66                  Just "always" -> return $ Just True
  67                  Just "never"  -> return $ Just False
  68                  Just "auto"   -> return $ Nothing
  69                  Just _        -> Write.fatal context $
  70                         W.text "--color option expects \"always\", \"auto\", or \"never\" as value"
  71                 return $ context{Context.color})
  72           "[always|auto|never]")
  73          "colorize output"
  74         , Option "" ["lang"]
  75          (ReqArg (\lang _context context -> do
  76                 return $ context{Context.langs=
  77                         Text.pack lang:Context.langs context})
  78           "[xx|xx-XX]")
  79          "RFC1766 / ISO 639-1 language code (eg, fr, en-GB, etc.)"
  80         ]
  81
  82 run :: Context -> String -> [String] -> IO ()
  83 run context cmd args =
  84         case cmd of
  85          "print"   -> Command.Print.run   context args
  86          "balance" -> Command.Balance.run context args
  87          _ -> usage >>= Write.fatal context .
  88                 ((W.text "unknown command: " <> (W.text $ TL.pack cmd) <> W.line) <>) .
  89                 W.text . TL.pack