cli/Hcompta/CLI/Command.hs

   1 {-# LANGUAGE LambdaCase #-}
   2 {-# LANGUAGE NamedFieldPuns #-}
   3 {-# LANGUAGE TupleSections #-}
   4 module Hcompta.CLI.Command where
   5
   6 import           System.Console.GetOpt
   7                  ( ArgDescr(..)
   8                  , OptDescr(..)
   9                  , usageInfo )
  10 import           System.Environment (getProgName)
  11 import           System.Exit (exitWith, ExitCode(..))
  12 import qualified System.IO as IO
  13
  14 import qualified Hcompta.CLI.Command.Balance as Command.Balance
  15 import qualified Hcompta.CLI.Command.Print   as Command.Print
  16 import qualified Hcompta.CLI.Args as Args
  17 import qualified Hcompta.CLI.Context as Context
  18 import           Hcompta.CLI.Context (Context)
  19 import qualified Hcompta.CLI.Write as Write
  20
  21 usage :: IO String
  22 usage = do
  23         bin <- getProgName
  24         return $ unlines $
  25                 [ "SYNTAX "
  26                 , "  "++bin++" [option..] <command> [arguments]"
  27                 , ""
  28                 , usageInfo "OPTIONS" options
  29                 , "COMMANDS"
  30                 , "  balance"
  31                 , "  print"
  32                 ]
  33
  34 options :: Args.Options Context
  35 options =
  36         [ Option "h" ["help"]
  37          (NoArg (\_opts -> do
  38                 usage >>= IO.hPutStr IO.stderr
  39                 exitWith ExitSuccess))
  40          "show this help"
  41         , Option "v" ["verbose"]
  42          (NoArg (\context -> return $ context{Context.verb=True}))
  43          "show intermediate results"
  44         , Option "" ["color"]
  45          (OptArg (\arg context -> do
  46                 color <- case arg of
  47                  Nothing       -> return $ Just True
  48                  Just "always" -> return $ Just True
  49                  Just "never"  -> return $ Just False
  50                  Just "auto"   -> return $ Nothing
  51                  Just _        -> Write.fatal context "--color option expects \"always\", \"auto\", or \"never\" as value"
  52                 return $ context{Context.color})
  53           "[always|auto|never]")
  54          "colorize output"
  55         ]
  56
  57 run :: Context -> String -> [String] -> IO ()
  58 run context cmd args =
  59         case cmd of
  60          "print"   -> Command.Print.run   context args
  61          "balance" -> Command.Balance.run context args
  62          _ -> usage >>= Write.fatal context . (("unknown command: " ++ cmd ++ "\n") ++)