cli/Hcompta/CLI/Command.hs

   1 {-# LANGUAGE NamedFieldPuns #-}
   2 {-# LANGUAGE TupleSections #-}
   3 module Hcompta.CLI.Command where
   4
   5 import           System.Console.GetOpt
   6                  ( ArgDescr(..)
   7                  , OptDescr(..)
   8                  , usageInfo )
   9 import           System.Environment (getProgName)
  10 import           System.Exit (exitWith, ExitCode(..))
  11 import qualified System.IO as IO
  12
  13 import           Hcompta.CLI.Context (Context)
  14 import qualified Hcompta.CLI.Args as Args
  15 import qualified Hcompta.CLI.Command.Balance as Command.Balance
  16 import qualified Hcompta.CLI.Command.Print   as Command.Print
  17 import qualified Hcompta.CLI.Context as Context
  18 import qualified Hcompta.CLI.Write as Write
  19
  20 usage :: IO String
  21 usage = do
  22         bin <- getProgName
  23         return $ unlines $
  24                 [ "SYNTAX "
  25                 , "  "++bin++" [option..] <command> [arguments]"
  26                 , ""
  27                 , usageInfo "OPTIONS" options
  28                 , "COMMANDS (use "++bin++" <command> --help for specific help)"
  29                 , "  balance [-i FILE]"
  30                 , "  print   [-i FILE]"
  31                 ]
  32
  33 options :: Args.Options Context
  34 options =
  35         [ Option "h" ["help"]
  36          (NoArg (\_opts -> do
  37                 usage >>= IO.hPutStr IO.stderr
  38                 exitWith ExitSuccess))
  39          "show this help"
  40         , Option "v" ["verbosity"]
  41          (OptArg (\arg context ->
  42                 case arg of
  43                  Nothing      ->
  44                         case Context.verbosity context of
  45                          v | v < maxBound ->
  46                                 return $ context{Context.verbosity=succ v}
  47                          _ -> return $ context
  48                  Just "error" -> return $ context{Context.verbosity=Context.Verbosity_Error}
  49                  Just "warn"  -> return $ context{Context.verbosity=Context.Verbosity_Warn}
  50                  Just "info"  -> return $ context{Context.verbosity=Context.Verbosity_Info}
  51                  Just "debug" -> return $ context{Context.verbosity=Context.Verbosity_Debug}
  52                  Just _       -> Write.fatal context
  53                          "--verbosity option expects \"error\", \"warn\", \"info\", or \"debug\" as value")
  54                 "error|warn|info|debug"
  55                 )
  56          "increment or set verbosity level, can be use multiple times"
  57         , Option "" ["color"]
  58          (OptArg (\arg context -> do
  59                 color <- case arg of
  60                  Nothing       -> return $ Just True
  61                  Just "always" -> return $ Just True
  62                  Just "never"  -> return $ Just False
  63                  Just "auto"   -> return $ Nothing
  64                  Just _        -> Write.fatal context
  65                          "--color option expects \"always\", \"auto\", or \"never\" as value"
  66                 return $ context{Context.color})
  67           "[always|auto|never]")
  68          "colorize output"
  69         ]
  70
  71 run :: Context -> String -> [String] -> IO ()
  72 run context cmd args =
  73         case cmd of
  74          "print"   -> Command.Print.run   context args
  75          "balance" -> Command.Balance.run context args
  76          _ -> usage >>= Write.fatal context . (("unknown command: " ++ cmd ++ "\n") ++)