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.Calc.Balance
  20 import qualified Hcompta.Format.Ledger.Journal
  21 import qualified Hcompta.Format.Ledger.Read
  22 -- import qualified Hcompta.Format.Ledger.Write
  23
  24 data Ctx
  25  =   Ctx
  26  { ctx_input :: [FilePath]
  27  } deriving (Eq, Show)
  28
  29 nil :: Ctx
  30 nil =
  31         Ctx
  32          { ctx_input = []
  33          }
  34
  35 usage :: IO String
  36 usage = do
  37         bin <- Env.getProgName
  38         return $ unlines $
  39                 [ "SYNTAX "
  40                 , "  "++bin++" balance [option..]"
  41                 , ""
  42                 , usageInfo "OPTIONS" options
  43                 ]
  44
  45 options :: Args.Options Ctx
  46 options =
  47         [ Option "h" ["help"]
  48          (NoArg (\_ctx -> do
  49                 usage >>= IO.hPutStr IO.stderr
  50                 exitWith ExitSuccess))
  51          "show this help"
  52         , Option "i" ["input"]
  53          (ReqArg (\s ctx -> do
  54                 return $ ctx{ctx_input=s:ctx_input ctx}) "FILE")
  55          "read data from given file"
  56         ]
  57
  58 run :: Context.Context -> [String] -> IO ()
  59 run context args = do
  60         (ctx, _) <- Args.parse context usage options (nil, args)
  61         (flip mapM) (ctx_input ctx) $ \path -> do
  62                 liftIO $ runExceptT $
  63                         Hcompta.Format.Ledger.Read.file path
  64                 >>= \x -> case x of
  65                  Left  ko -> return $ Left (path, ko)
  66                  Right ok -> return $ Right ok
  67         >>= return . Data.Either.partitionEithers
  68         >>= \x -> case x of
  69          (kos@(_:_), _oks) ->
  70                 (flip mapM_) kos $ \(_path, ko) ->
  71                         Write.fatal context $ ko
  72          ([], journals) -> do
  73                 putStrLn $ show $
  74                         Data.List.foldl
  75                          (\b j -> Hcompta.Calc.Balance.journal
  76                                  (Hcompta.Format.Ledger.Journal.to_Model j) b)
  77                          Hcompta.Calc.Balance.nil
  78                          journals