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"
  29                 , "  balance"
  30                 , "  print"
  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" ["verbose"]
  41          (NoArg (\context -> return $ context{Context.verb=True}))
  42          "show intermediate results"
  43         , Option "" ["color"]
  44          (OptArg (\arg context -> do
  45                 color <- case arg of
  46                  Nothing       -> return $ Just True
  47                  Just "always" -> return $ Just True
  48                  Just "never"  -> return $ Just False
  49                  Just "auto"   -> return $ Nothing
  50                  Just _        -> Write.fatal context "--color option expects \"always\", \"auto\", or \"never\" as value"
  51                 return $ context{Context.color})
  52           "[always|auto|never]")
  53          "colorize output"
  54         ]
  55
  56 run :: Context -> String -> [String] -> IO ()
  57 run context cmd args =
  58         case cmd of
  59          "print"   -> Command.Print.run   context args
  60          "balance" -> Command.Balance.run context args
  61          _ -> usage >>= Write.fatal context . (("unknown command: " ++ cmd ++ "\n") ++)