diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.11.1.2 + +- Exit with an error code when any external script fails - https://github.com/apauley/hledger-flow/issues/28 +- Capture external process output when doing parallel processing, in order to better prevent mangled concurrent output. +- Allow users to specify a path to an hledger executable +- Display a user-friendly error message if hledger cannot be found - https://github.com/apauley/hledger-flow/issues/22 + ## 0.11.1.1 - Support input files from the year 2011 - https://github.com/apauley/hledger-flow/issues/27 diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -14,7 +14,13 @@ import Hledger.Flow.Reports import Hledger.Flow.CSVImport -type SubcommandParams = (Maybe FilePath, Bool, Bool, Bool) +data SubcommandParams = SubcommandParams { maybeBaseDir :: Maybe FilePath + , hledgerPathOpt :: Maybe FilePath + , verbose :: Bool + , showOpts :: Bool + , sequential :: Bool + } + deriving (Show) data Command = Version (Maybe Text) | Import SubcommandParams | Report SubcommandParams deriving (Show) main :: IO () @@ -26,20 +32,24 @@ Report subParams -> toReportOptions subParams >>= generateReports toImportOptions :: SubcommandParams -> IO IT.ImportOptions -toImportOptions (maybeBaseDir, verbose, showOpts, sequential) = do - bd <- dirOrPwd maybeBaseDir +toImportOptions params = do + bd <- dirOrPwd $ maybeBaseDir params + hli <- hledgerInfoFromPath $ hledgerPathOpt params return IT.ImportOptions { IT.baseDir = bd - , IT.verbose = verbose - , IT.showOptions = showOpts - , IT.sequential = sequential } + , IT.hledgerInfo = hli + , IT.verbose = verbose params + , IT.showOptions = showOpts params + , IT.sequential = sequential params } toReportOptions :: SubcommandParams -> IO RT.ReportOptions -toReportOptions (maybeBaseDir, verbose, showOpts, sequential) = do - bd <- dirOrPwd maybeBaseDir +toReportOptions params = do + bd <- dirOrPwd $ maybeBaseDir params + hli <- hledgerInfoFromPath $ hledgerPathOpt params return RT.ReportOptions { RT.baseDir = bd - , RT.verbose = verbose - , RT.showOptions = showOpts - , RT.sequential = sequential } + , RT.hledgerInfo = hli + , RT.verbose = verbose params + , RT.showOptions = showOpts params + , RT.sequential = sequential params } parser :: Parser Command parser = fmap Import (subcommand "import" "Converts CSV transactions into categorised journal files" subcommandParser) @@ -47,8 +57,9 @@ <|> fmap Version (subcommand "version" "Display version information" noArgs) subcommandParser :: Parser SubcommandParams -subcommandParser = (,,,) +subcommandParser = SubcommandParams <$> optional (argPath "basedir" "The hledger-flow base directory") + <*> optional (optPath "hledger-path" 'H' "The full path to an hledger executable") <*> switch (long "verbose" <> short 'v' <> help "Print more verbose output") <*> switch (long "show-options" <> help "Print the options this program will run with") <*> switch (long "sequential" <> help "Disable parallel processing") diff --git a/hledger-flow.cabal b/hledger-flow.cabal --- a/hledger-flow.cabal +++ b/hledger-flow.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: f8d8a671bb403b7d049e7310c834a0396e836ca37eb0c7717ccb48a15691213d +-- hash: 752e52ff23c6e0069c279dc21baa46e6c8b0b20124b506e7bdca5d52136bb483 name: hledger-flow -version: 0.11.1.1 +version: 0.11.1.2 synopsis: An hledger workflow focusing on automated statement import and classification. description: Please see the README on GitHub at category: Finance, Console diff --git a/src/Hledger/Flow/CSVImport.hs b/src/Hledger/Flow/CSVImport.hs --- a/src/Hledger/Flow/CSVImport.hs +++ b/src/Hledger/Flow/CSVImport.hs @@ -4,11 +4,11 @@ ( importCSVs ) where -import Turtle +import Turtle hiding (stdout, stderr, proc, procStrictWithErr) import Prelude hiding (FilePath, putStrLn, take) import qualified Data.Text as T import qualified Data.List.NonEmpty as NonEmpty -import Hledger.Flow.Types (LogMessage) +import qualified Hledger.Flow.Types as FlowTypes import Hledger.Flow.Import.Types import Hledger.Flow.Common import Control.Concurrent.STM @@ -18,10 +18,10 @@ do ch <- liftIO newTChanIO logHandle <- fork $ consoleChannelLoop ch - liftIO $ if (showOptions opts) then channelOut ch (repr opts) else return () + liftIO $ if (showOptions opts) then channelOutLn ch (repr opts) else return () liftIO $ logVerbose opts ch "Starting import" (journals, diff) <- time $ liftIO $ importCSVs' opts ch - liftIO $ channelOut ch $ format ("Imported "%d%" journals in "%s) (length journals) $ repr diff + liftIO $ channelOutLn ch $ format ("Imported "%d%" journals in "%s) (length journals) $ repr diff liftIO $ terminateChannelLoop ch wait logHandle ) @@ -32,9 +32,9 @@ inputFilePattern :: Pattern Text inputFilePattern = contains (once (oneOf pathSeparators) <> asciiCI "1-in" <> once (oneOf pathSeparators) <> plus digit <> once (oneOf pathSeparators)) -importCSVs' :: ImportOptions -> TChan LogMessage -> IO [FilePath] +importCSVs' :: ImportOptions -> TChan FlowTypes.LogMessage -> IO [FilePath] importCSVs' opts ch = do - channelOut ch "Collecting input files..." + channelOutLn ch "Collecting input files..." (inputFiles, diff) <- time $ single . shellToList . onlyFiles $ find inputFilePattern $ baseDir opts let fileCount = length inputFiles if (fileCount == 0) then @@ -45,20 +45,20 @@ errExit 1 ch msg [] else do - channelOut ch $ format ("Found "%d%" input files in "%s%". Proceeding with import...") fileCount (repr diff) + channelOutLn ch $ format ("Found "%d%" input files in "%s%". Proceeding with import...") fileCount (repr diff) let actions = map (extractAndImport opts ch) inputFiles :: [IO FilePath] importedJournals <- if (sequential opts) then sequence actions else single . shellToList $ parallel actions sh $ writeIncludesUpTo opts ch "import" importedJournals return importedJournals -extractAndImport :: ImportOptions -> TChan LogMessage -> FilePath -> IO FilePath +extractAndImport :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> IO FilePath extractAndImport opts ch inputFile = do case extractImportDirs inputFile of Right importDirs -> importCSV opts ch importDirs inputFile Left errorMessage -> do errExit 1 ch errorMessage inputFile -importCSV :: ImportOptions -> TChan LogMessage -> ImportDirs -> FilePath -> IO FilePath +importCSV :: ImportOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> FilePath -> IO FilePath importCSV opts ch importDirs srcFile = do let preprocessScript = accountDir importDirs "preprocess" let constructScript = accountDir importDirs "construct" @@ -74,33 +74,34 @@ mktree $ directory journalOut importFun csvFile journalOut -preprocessIfNeeded :: ImportOptions -> TChan LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath +preprocessIfNeeded :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath preprocessIfNeeded opts ch script bank account owner src = do shouldPreprocess <- verboseTestFile opts ch script if shouldPreprocess then preprocess opts ch script bank account owner src else return src -preprocess :: ImportOptions -> TChan LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath +preprocess :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath preprocess opts ch script bank account owner src = do let csvOut = changePathAndExtension "2-preprocessed" "csv" src mktree $ directory csvOut let script' = format fp script :: Text - let action = proc script' [format fp src, format fp csvOut, lineToText bank, lineToText account, lineToText owner] empty + let action = (parAwareProc opts) script' [format fp src, format fp csvOut, lineToText bank, lineToText account, lineToText owner] empty let relScript = relativeToBase opts script let relSrc = relativeToBase opts src let msg = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc - _ <- logVerboseTime opts ch msg action + ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action + channelOut ch stdOut return csvOut -hledgerImport :: ImportOptions -> TChan LogMessage -> FilePath -> FilePath -> IO FilePath +hledgerImport :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO FilePath hledgerImport opts ch csvSrc journalOut = do case extractImportDirs csvSrc of Right importDirs -> hledgerImport' opts ch importDirs csvSrc journalOut Left errorMessage -> do errExit 1 ch errorMessage csvSrc -hledgerImport' :: ImportOptions -> TChan LogMessage -> ImportDirs -> FilePath -> FilePath -> IO FilePath +hledgerImport' :: ImportOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> FilePath -> FilePath -> IO FilePath hledgerImport' opts ch importDirs csvSrc journalOut = do let candidates = rulesFileCandidates csvSrc importDirs maybeRulesFile <- firstExistingFile candidates @@ -108,9 +109,11 @@ case maybeRulesFile of Just rf -> do let relRules = relativeToBase opts rf - let action = proc "hledger" ["print", "--rules-file", format fp rf, "--file", format fp csvSrc, "--output-file", format fp journalOut] empty + let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text + let action = (parAwareProc opts) hledger ["print", "--rules-file", format fp rf, "--file", format fp csvSrc, "--output-file", format fp journalOut] empty let msg = format ("importing '"%fp%"' using rules file '"%fp%"'") relCSV relRules - _ <- logVerboseTime opts ch msg action + ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action + channelOut ch stdOut return journalOut Nothing -> do @@ -151,14 +154,15 @@ map ( srcSpecificFilename) [accountDir importDirs, bankDir importDirs, importDir importDirs] else [] -customConstruct :: ImportOptions -> TChan LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> FilePath -> IO FilePath +customConstruct :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> FilePath -> IO FilePath customConstruct opts ch constructScript bank account owner csvSrc journalOut = do let script = format fp constructScript :: Text let importOut = inproc script [format fp csvSrc, "-", lineToText bank, lineToText account, lineToText owner] empty - let action = proc "hledger" ["print", "--ignore-assertions", "--file", "-", "--output-file", format fp journalOut] importOut + let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text + let action = (parAwareProc opts) hledger ["print", "--ignore-assertions", "--file", "-", "--output-file", format fp journalOut] importOut let relScript = relativeToBase opts constructScript let relSrc = relativeToBase opts csvSrc let msg = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc - _ <- logVerboseTime opts ch msg action - + ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action + channelOut ch stdOut return journalOut diff --git a/src/Hledger/Flow/Common.hs b/src/Hledger/Flow/Common.hs --- a/src/Hledger/Flow/Common.hs +++ b/src/Hledger/Flow/Common.hs @@ -3,14 +3,18 @@ module Hledger.Flow.Common ( docURL , versionInfo + , hledgerPathFromOption + , hledgerVersionFromPath + , hledgerInfoFromPath , showCmdArgs , consoleChannelLoop , terminateChannelLoop - , channelOut - , channelErr + , channelOut, channelOutLn + , channelErr, channelErrLn , errExit , logVerbose - , logVerboseTime + , timeAndExitOnErr + , parAwareProc , verboseTestFile , relativeToBase , relativeToBase' @@ -66,6 +70,33 @@ versionInfo :: NE.NonEmpty Line versionInfo = textToLines $ T.pack ("hledger-flow " ++ Version.showVersion version) +hledgerPathFromOption :: Maybe FilePath -> IO FilePath +hledgerPathFromOption pathOption = do + case pathOption of + Just h -> do + isOnDisk <- testfile h + if isOnDisk then return h else do + let msg = format ("Unable to find hledger at "%fp) h + errExit' 1 (T.hPutStrLn H.stderr) msg h + Nothing -> do + maybeH <- which "hledger" + case maybeH of + Just h -> return h + Nothing -> do + let msg = "Unable to find hledger in your path.\n" + <> "You need to either install hledger, or add it to your PATH, or provide the path to an hledger executable.\n\n" + <> "There are a number of installation options on the hledger website: https://hledger.org/download.html" + errExit' 1 (T.hPutStrLn H.stderr) msg "/" + +hledgerVersionFromPath :: FilePath -> IO Text +hledgerVersionFromPath hlp = fmap (T.strip . linesToText) (single $ shellToList $ inproc (format fp hlp) ["--version"] empty) + +hledgerInfoFromPath :: Maybe FilePath -> IO HledgerInfo +hledgerInfoFromPath pathOption = do + hlp <- hledgerPathFromOption pathOption + hlv <- hledgerVersionFromPath hlp + return $ HledgerInfo hlp hlv + showCmdArgs :: [Text] -> Text showCmdArgs args = T.intercalate " " (map escapeArg args) @@ -75,12 +106,21 @@ channelOut :: TChan LogMessage -> Text -> IO () channelOut ch txt = atomically $ writeTChan ch $ StdOut txt +channelOutLn :: TChan LogMessage -> Text -> IO () +channelOutLn ch txt = channelOut ch (txt <> "\n") + channelErr :: TChan LogMessage -> Text -> IO () channelErr ch txt = atomically $ writeTChan ch $ StdErr txt +channelErrLn :: TChan LogMessage -> Text -> IO () +channelErrLn ch txt = channelErr ch (txt <> "\n") + errExit :: Int -> TChan LogMessage -> Text -> a -> IO a -errExit exitStatus ch errorMessage dummyReturnValue = do - channelErr ch errorMessage +errExit exitStatus ch = errExit' exitStatus (channelErrLn ch) + +errExit' :: Int -> (Text -> IO ()) -> Text -> a -> IO a +errExit' exitStatus logFun errorMessage dummyReturnValue = do + logFun errorMessage sleep 0.1 _ <- exit $ ExitFailure exitStatus return dummyReturnValue @@ -93,17 +133,17 @@ logToChannel :: TChan LogMessage -> Text -> IO () logToChannel ch msg = do ts <- timestampPrefix msg - channelErr ch ts + channelErrLn ch ts consoleChannelLoop :: TChan LogMessage -> IO () consoleChannelLoop ch = do logMsg <- atomically $ readTChan ch case logMsg of StdOut msg -> do - T.hPutStrLn H.stdout msg + T.hPutStr H.stdout msg consoleChannelLoop ch StdErr msg -> do - T.hPutStrLn H.stderr msg + T.hPutStr H.stderr msg consoleChannelLoop ch Terminate -> return () @@ -113,12 +153,41 @@ logVerbose :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO () logVerbose opts ch msg = if (verbose opts) then logToChannel ch msg else return () -logVerboseTime :: (HasVerbosity o, HasExitCode a) => o -> TChan LogMessage -> Text -> IO a -> IO (a, NominalDiffTime) -logVerboseTime opts ch msg action = do +logTimedAction :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO FullOutput -> IO FullTimedOutput +logTimedAction opts ch msg action = do logVerbose opts ch $ format ("Begin: "%s) msg - (result, diff) <- time action - logVerbose opts ch $ format ("End: "%s%" "%s%" ("%s%")") msg (repr $ exitCode result) (repr diff) - return (result, diff) + timed@((ec, _, _), diff) <- time action + logVerbose opts ch $ format ("End: "%s%" "%s%" ("%s%")") msg (repr ec) (repr diff) + return timed + +timeAndExitOnErr :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO FullOutput -> IO FullTimedOutput +timeAndExitOnErr opts ch msg action = do + timed@((ec, stdOut, stdErr), _) <- logTimedAction opts ch msg action + if not (T.null stdErr) + then channelErr ch stdErr + else return () + case ec of + ExitFailure i -> do + let msgOut = if not (T.null stdOut) + then format ("Standard output:\n"%s%"\n") stdOut + else "" + + let msgErr = if not (T.null stdErr) + then format ("Error output:\n"%s%"\n") stdErr + else "" + + let exitMsg = format ("\nhledger-flow: an external process exited with exit code "%d%". \n" + %s%s%"\nSee verbose output for more details.") i msgOut msgErr + errExit i ch exitMsg timed + ExitSuccess -> return timed + +procWithEmptyOutput :: MonadIO io => Text -> [Text] -> Shell Line -> io FullOutput +procWithEmptyOutput cmd args stdinput = do + ec <- proc cmd args stdinput + return (ec, T.empty, T.empty) + +parAwareProc :: (HasSequential o, MonadIO io) => o -> Text -> [Text] -> Shell Line -> io FullOutput +parAwareProc opts = if (sequential opts) then procWithEmptyOutput else procStrictWithErr verboseTestFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> IO Bool verboseTestFile opts ch p = do diff --git a/src/Hledger/Flow/Import/Types.hs b/src/Hledger/Flow/Import/Types.hs --- a/src/Hledger/Flow/Import/Types.hs +++ b/src/Hledger/Flow/Import/Types.hs @@ -6,16 +6,20 @@ import Hledger.Flow.Types data ImportOptions = ImportOptions { baseDir :: FilePath + , hledgerInfo :: HledgerInfo , verbose :: Bool , showOptions :: Bool , sequential :: Bool } deriving (Show) instance HasVerbosity ImportOptions where - verbose (ImportOptions _ v _ _) = v + verbose (ImportOptions _ _ v _ _) = v +instance HasSequential ImportOptions where + sequential (ImportOptions _ _ _ _ sq) = sq + instance HasBaseDir ImportOptions where - baseDir (ImportOptions bd _ _ _) = bd + baseDir (ImportOptions bd _ _ _ _) = bd data ImportDirs = ImportDirs { importDir :: FilePath , ownerDir :: FilePath diff --git a/src/Hledger/Flow/Report/Types.hs b/src/Hledger/Flow/Report/Types.hs --- a/src/Hledger/Flow/Report/Types.hs +++ b/src/Hledger/Flow/Report/Types.hs @@ -6,13 +6,18 @@ import Hledger.Flow.Types data ReportOptions = ReportOptions { baseDir :: FilePath + , hledgerInfo :: HledgerInfo , verbose :: Bool , showOptions :: Bool - , sequential :: Bool } + , sequential :: Bool + } deriving (Show) instance HasVerbosity ReportOptions where - verbose (ReportOptions _ v _ _) = v + verbose (ReportOptions _ _ v _ _) = v +instance HasSequential ReportOptions where + sequential (ReportOptions _ _ _ _ sq) = sq + instance HasBaseDir ReportOptions where - baseDir (ReportOptions bd _ _ _) = bd + baseDir (ReportOptions bd _ _ _ _) = bd diff --git a/src/Hledger/Flow/Reports.hs b/src/Hledger/Flow/Reports.hs --- a/src/Hledger/Flow/Reports.hs +++ b/src/Hledger/Flow/Reports.hs @@ -4,10 +4,10 @@ ( generateReports ) where -import Turtle +import Turtle hiding (stdout, stderr, proc) import Prelude hiding (FilePath, putStrLn, writeFile) import qualified Data.Text as T -import Hledger.Flow.Types (LogMessage, FullTimedOutput) +import qualified Hledger.Flow.Types as FlowTypes import Hledger.Flow.Report.Types import Hledger.Flow.Common import Control.Concurrent.STM @@ -17,20 +17,20 @@ do ch <- liftIO newTChanIO logHandle <- fork $ consoleChannelLoop ch - liftIO $ if (showOptions opts) then channelOut ch (repr opts) else return () + liftIO $ if (showOptions opts) then channelOutLn ch (repr opts) else return () (reports, diff) <- time $ liftIO $ generateReports' opts ch - liftIO $ channelOut ch $ format ("Generated "%d%" reports in "%s) (length reports) $ repr diff + liftIO $ channelOutLn ch $ format ("Generated "%d%" reports in "%s) (length reports) $ repr diff liftIO $ terminateChannelLoop ch wait logHandle ) -generateReports' :: ReportOptions -> TChan LogMessage -> IO [FilePath] +generateReports' :: ReportOptions -> TChan FlowTypes.LogMessage -> IO [FilePath] generateReports' opts ch = do logVerbose opts ch "Something will be here Real Soon Now (tm)" - channelOut ch "Report generation has not been implemented. Yet. https://github.com/apauley/hledger-flow/pull/4" + channelOutLn ch "Report generation has not been implemented. Yet. https://github.com/apauley/hledger-flow/pull/4" ownerReports opts ch "everyone" -ownerReports :: ReportOptions -> TChan LogMessage -> Text -> IO [FilePath] +ownerReports :: ReportOptions -> TChan FlowTypes.LogMessage -> Text -> IO [FilePath] ownerReports opts ch owner = do let journal = (baseDir opts) "all-years" <.> "journal" let reportsDir = (baseDir opts) "reports" fromText owner @@ -38,7 +38,7 @@ results <- if (sequential opts) then sequence actions else single $ shellToList $ parallel actions return $ map fst results -incomeStatement :: ReportOptions -> TChan LogMessage -> FilePath -> FilePath -> IO (FilePath, FullTimedOutput) +incomeStatement :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO (FilePath, FlowTypes.FullTimedOutput) incomeStatement opts ch journal reportsDir = do mktree reportsDir let outputFile = reportsDir "income-expenses" <.> "txt" @@ -46,27 +46,25 @@ let reportArgs = ["incomestatement"] ++ sharedOptions ++ ["--average", "--yearly"] generateReport' opts ch journal outputFile reportArgs -accountList :: ReportOptions -> TChan LogMessage -> FilePath -> FilePath -> IO (FilePath, FullTimedOutput) +accountList :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO (FilePath, FlowTypes.FullTimedOutput) accountList opts ch journal reportsDir = do let outputFile = reportsDir "accounts" <.> "txt" let reportArgs = ["accounts"] generateReport' opts ch journal outputFile reportArgs -generateReport' :: ReportOptions -> TChan LogMessage -> FilePath -> FilePath -> [Text] -> IO (FilePath, FullTimedOutput) +generateReport' :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> [Text] -> IO (FilePath, FlowTypes.FullTimedOutput) generateReport' opts ch journal outputFile args = do let reportsDir = directory outputFile mktree reportsDir let relativeJournal = relativeToBase opts journal let reportArgs = ["--file", format fp journal] ++ args let reportDisplayArgs = ["--file", format fp relativeJournal] ++ args - let action = procStrictWithErr "hledger" reportArgs empty + let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text + let action = procStrictWithErr hledger reportArgs empty let cmd = format ("hledger "%s) $ showCmdArgs reportDisplayArgs - result@((exitCode, stdOut, stdErr), _) <- logVerboseTime opts ch cmd action + result@((exitCode, stdOut, _), _) <- timeAndExitOnErr opts ch cmd action if not (T.null stdOut) then do writeTextFile outputFile (cmd <> "\n\n"<> stdOut) - channelOut ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile - else channelErr ch $ format ("No report output for '"%s%"' "%s) cmd (repr exitCode) - if not (T.null stdErr) - then channelErr ch $ stdErr - else return () + channelOutLn ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile + else channelErrLn ch $ format ("No report output for '"%s%"' "%s) cmd (repr exitCode) return (outputFile, result) diff --git a/src/Hledger/Flow/Types.hs b/src/Hledger/Flow/Types.hs --- a/src/Hledger/Flow/Types.hs +++ b/src/Hledger/Flow/Types.hs @@ -11,17 +11,16 @@ type FullOutput = (ExitCode, Text, Text) type FullTimedOutput = (FullOutput, NominalDiffTime) +data HledgerInfo = HledgerInfo { hlPath :: FilePath + , hlVersion :: Text + } + deriving (Show) + class HasVerbosity a where verbose :: a -> Bool class HasBaseDir a where baseDir :: a -> FilePath -class HasExitCode a where - exitCode :: a -> ExitCode - -instance HasExitCode ExitCode where - exitCode c = c - -instance HasExitCode FullOutput where - exitCode (c, _, _) = c +class HasSequential a where + sequential :: a -> Bool diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -3,14 +3,10 @@ module TestHelpers where -import Test.HUnit import Turtle import Prelude hiding (FilePath) -import qualified Data.Map.Strict as Map -import qualified Control.Foldl as Fold -import qualified Data.Text as T -import qualified Data.List as List (sort) +import qualified Hledger.Flow.Types as FlowTypes import Hledger.Flow.Import.Types import Hledger.Flow.Common @@ -49,8 +45,11 @@ extraFiles = ["import/john/bogartbank/savings/2017-opening.journal"] :: [FilePath] hiddenFiles = [".hiddenfile", "checking/.DS_Store", "import/john/bogartbank/savings/1-in/.anotherhiddenfile", "import/john/bogartbank/checking/1-in/2018/.hidden"] :: [FilePath] +defaultHlInfo :: FlowTypes.HledgerInfo +defaultHlInfo = FlowTypes.HledgerInfo "/path/to/hledger" "1.2.3" + defaultOpts :: FilePath -> ImportOptions -defaultOpts bd = ImportOptions bd False False False +defaultOpts bd = ImportOptions bd defaultHlInfo False False False toJournals :: [FilePath] -> [FilePath] toJournals = map (changePathAndExtension "3-journal" "journal")