{-# LANGUAGE LambdaCase #-} module Hcompta.CLI.Command.Balance where import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (runExceptT) import qualified Data.Either import qualified Data.List import System.Console.GetOpt ( ArgDescr(..) , OptDescr(..) , usageInfo ) import System.Environment (getProgName) import System.Exit (exitWith, ExitCode(..)) import qualified System.IO as IO import qualified Hcompta.CLI.Args as Args import qualified Hcompta.CLI.Context as Context import qualified Hcompta.CLI.Write as Write import qualified Hcompta.Calc.Balance import qualified Hcompta.Format.Ledger.Read -- import qualified Hcompta.Format.Ledger.Write import qualified Hcompta.Format.Ledger.Journal data Ctx = Ctx { ctx_input :: [FilePath] } deriving (Eq, Show) nil :: Ctx nil = Ctx { ctx_input = [] } usage :: IO String usage = do bin <- getProgName return $ unlines $ [ "SYNTAX " , " "++bin++" balance [option..]" , "" , usageInfo "OPTIONS" options ] options :: Args.Options Ctx options = [ Option "h" ["help"] (NoArg (\_ctx -> do usage >>= IO.hPutStr IO.stderr exitWith ExitSuccess)) "show this help" , Option "i" ["input"] (ReqArg (\s ctx -> do return $ ctx{ctx_input=s:ctx_input ctx}) "file.ledger") "read data from given file" ] run :: Context.Context -> [String] -> IO () run context args = do (ctx, _) <- Args.parse context usage options (nil, args) (flip mapM) (ctx_input ctx) $ \path -> do liftIO $ runExceptT $ Hcompta.Format.Ledger.Read.file path >>= \case Left ko -> return $ Left (path, ko) Right ok -> return $ Right ok >>= return . Data.Either.partitionEithers >>= \case (kos@(_:_), _oks) -> (flip mapM_) kos $ \(_path, ko) -> Write.fatal context $ ko ([], journals) -> do putStrLn $ show $ Data.List.foldl (\b j -> Hcompta.Calc.Balance.journal (Hcompta.Format.Ledger.Journal.to_Model j) b) Hcompta.Calc.Balance.nil journals