{-# LANGUAGE NamedFieldPuns #-} module Hcompta.CLI.Command.Print where import Control.Arrow (first) import Control.Applicative ((<$>)) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (runExceptT) import qualified Data.Either import System.Console.GetOpt ( ArgDescr(..) , OptDescr(..) , usageInfo ) import System.Environment as Env (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.Format.Ledger.Journal as Ledger.Journal import qualified Hcompta.Format.Ledger.Read as Ledger.Read import qualified Hcompta.Format.Ledger.Write as Ledger.Write import qualified Hcompta.CLI.Format.Ledger as CLI.Ledger data Ctx = Ctx { ctx_input :: [FilePath] } deriving (Eq, Show) nil :: Ctx nil = Ctx { ctx_input = [] } usage :: IO String usage = do bin <- Env.getProgName return $unlines $ [ "SYNTAX " , " "++bin++" print [option..]" , "" , usageInfo "OPTIONS" options ] options :: Args.Options Ctx options = [ Option "h" ["help"] (NoArg (\_context _ctx -> do usage >>= IO.hPutStr IO.stderr exitWith ExitSuccess)) "show this help" , Option "i" ["input"] (ReqArg (\s _context ctx -> do return $ ctx{ctx_input=s:ctx_input ctx}) "FILE") "read data from given file, can be use multiple times" ] run :: Context.Context -> [String] -> IO () run context args = do (ctx, _) <- first (\ctx -> ctx{ctx_input=reverse $ ctx_input ctx}) <$> Args.parse context usage options (nil, args) CLI.Ledger.paths context $ ctx_input ctx >>= do mapM $ \path -> do liftIO $ runExceptT $ Ledger.Read.file path >>= \x -> case x of Left ko -> return $ Left (path, ko) Right ok -> return $ Right ok >>= return . Data.Either.partitionEithers >>= \x -> case x of (kos@(_:_), _oks) -> (flip mapM_) kos $ \(_path, ko) -> Write.fatal context $ show ko ([], journals) -> do with_color <- Write.with_color context IO.stdout let journal = Ledger.Journal.flatten $ Ledger.Journal.unions journals Ledger.Write.put with_color IO.stdout $ do Ledger.Write.journal journal