cli/Hcompta/CLI/Command/Balance.hs

   1 {-# LANGUAGE LambdaCase #-}
   2 module Hcompta.CLI.Command.Balance where
   3
   4 import           Control.Monad.IO.Class (liftIO)
   5 import           Control.Monad.Trans.Except (runExceptT)
   6 import qualified Data.Either
   7 import qualified Data.List
   8 import           System.Console.GetOpt
   9                  ( ArgDescr(..)
  10                  , OptDescr(..)
  11                  , usageInfo
  12                  )
  13 import           System.Environment as Env (getProgName)
  14 import           System.Exit (exitWith, ExitCode(..))
  15 import qualified System.IO as IO
  16
  17 import qualified Hcompta.CLI.Args as Args
  18 import qualified Hcompta.CLI.Context as Context
  19 import qualified Hcompta.CLI.Write as Write
  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"
  57         ]
  58
  59 run :: Context.Context -> [String] -> IO ()
  60 run context args = do
  61         (ctx, _) <- Args.parse context usage options (nil, args)
  62         (flip mapM) (ctx_input ctx) $ \path -> do
  63                 liftIO $ runExceptT $
  64                         Hcompta.Format.Ledger.Read.file path
  65                 >>= \case
  66                  Left  ko -> return $ Left (path, ko)
  67                  Right ok -> return $ Right ok
  68         >>= return . Data.Either.partitionEithers
  69         >>= \case
  70          (kos@(_:_), _oks) ->
  71                 (flip mapM_) kos $ \(_path, ko) ->
  72                         Write.fatal context $ ko
  73          ([], journals) -> do
  74                 putStrLn $ show $
  75                         Data.List.foldl
  76                          (\b j -> Hcompta.Calc.Balance.journal
  77                                  (Hcompta.Format.Ledger.Journal.to_Model j) b)
  78                          Hcompta.Calc.Balance.nil
  79                          journals