cli/Hcompta/CLI/Command/Balance.hs

   1 module Hcompta.CLI.Command.Balance where
   2
   3 import           Control.Monad.IO.Class (liftIO)
   4 import           Control.Monad.Trans.Except (runExceptT)
   5 import qualified Data.Either
   6 import qualified Data.List
   7 import           System.Console.GetOpt
   8                  ( ArgDescr(..)
   9                  , OptDescr(..)
  10                  , usageInfo
  11                  )
  12 import           System.Environment as Env (getProgName)
  13 import           System.Exit (exitWith, ExitCode(..))
  14 import qualified System.IO as IO
  15
  16 import qualified Hcompta.CLI.Args as Args
  17 import qualified Hcompta.CLI.Context as Context
  18 import qualified Hcompta.CLI.Write as Write
  19 import qualified Hcompta.CLI.Format.Ledger as CLI.Ledger
  20 import qualified Hcompta.Calc.Balance
  21 import qualified Hcompta.Format.Ledger.Journal
  22 import qualified Hcompta.Format.Ledger.Read
  23 -- import qualified Hcompta.Format.Ledger.Write
  24
  25 data Ctx
  26  =   Ctx
  27  { ctx_input :: [FilePath]
  28  } deriving (Eq, Show)
  29
  30 nil :: Ctx
  31 nil =
  32         Ctx
  33          { ctx_input = []
  34          }
  35
  36 usage :: IO String
  37 usage = do
  38         bin <- Env.getProgName
  39         return $ unlines $
  40                 [ "SYNTAX "
  41                 , "  "++bin++" balance [option..]"
  42                 , ""
  43                 , usageInfo "OPTIONS" options
  44                 ]
  45
  46 options :: Args.Options Ctx
  47 options =
  48         [ Option "h" ["help"]
  49          (NoArg (\_ctx -> do
  50                 usage >>= IO.hPutStr IO.stderr
  51                 exitWith ExitSuccess))
  52          "show this help"
  53         , Option "i" ["input"]
  54          (ReqArg (\s ctx -> do
  55                 return $ ctx{ctx_input=s:ctx_input ctx}) "FILE")
  56          "read data from given file, can be use multiple times"
  57         ]
  58
  59 run :: Context.Context -> [String] -> IO ()
  60 run context args = do
  61         (ctx, _) <- Args.parse context usage options (nil, args)
  62         CLI.Ledger.paths context $ ctx_input ctx
  63         >>= do mapM $ \path -> do
  64                 liftIO $ runExceptT $
  65                         Hcompta.Format.Ledger.Read.file path
  66                 >>= \x -> case x of
  67                  Left  ko -> return $ Left (path, ko)
  68                  Right ok -> return $ Right ok
  69         >>= return . Data.Either.partitionEithers
  70         >>= \x -> case x of
  71          (kos@(_:_), _oks) ->
  72                 (flip mapM_) kos $ \(_path, ko) ->
  73                         Write.fatal context $ ko
  74          ([], journals) -> do
  75                 CLI.Ledger.equilibre context journals
  76                 putStrLn $ show $
  77                         Data.List.foldl
  78                          (\b j -> Hcompta.Calc.Balance.journal
  79                                  (Hcompta.Format.Ledger.Journal.to_Model j) b)
  80                          Hcompta.Calc.Balance.nil
  81                          journals