1 {-# LANGUAGE NamedFieldPuns #-}
2 module Hcompta.CLI.Command.Print where
4 import Control.Arrow (first)
5 import Control.Applicative ((<$>))
6 import Control.Monad.IO.Class (liftIO)
7 import Control.Monad.Trans.Except (runExceptT)
8 import qualified Data.Either
9 import System.Console.GetOpt
13 import System.Environment as Env (getProgName)
14 import System.Exit (exitWith, ExitCode(..))
15 import qualified System.IO as IO
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.Format.Ledger.Journal as Ledger.Journal
21 import qualified Hcompta.Format.Ledger.Read as Ledger.Read
22 import qualified Hcompta.Format.Ledger.Write as Ledger.Write
23 import qualified Hcompta.CLI.Format.Ledger as CLI.Ledger
27 { ctx_input :: [FilePath]
38 bin <- Env.getProgName
41 , " "++bin++" print [option..]"
43 , usageInfo "OPTIONS" options
46 options :: Args.Options Ctx
49 (NoArg (\_context _ctx -> do
50 usage >>= IO.hPutStr IO.stderr
51 exitWith ExitSuccess))
53 , Option "i" ["input"]
54 (ReqArg (\s _context ctx -> do
55 return $ ctx{ctx_input=s:ctx_input ctx}) "FILE")
56 "read data from given file, can be use multiple times"
59 run :: Context.Context -> [String] -> IO ()
62 first (\ctx -> ctx{ctx_input=reverse $ ctx_input ctx}) <$>
63 Args.parse context usage options (nil, args)
64 CLI.Ledger.paths context $ ctx_input ctx
65 >>= do mapM $ \path -> do
69 Left ko -> return $ Left (path, ko)
70 Right ok -> return $ Right ok
71 >>= return . Data.Either.partitionEithers
74 (flip mapM_) kos $ \(_path, ko) -> Write.fatal context $ show ko
76 with_color <- Write.with_color context IO.stdout
77 let journal = Ledger.Journal.flatten $ Ledger.Journal.unions journals
78 Ledger.Write.put with_color IO.stdout $ do
79 Ledger.Write.journal journal