Merge pull request #30 from apauley/exit-on-err

Exit on err

Author: apauley

.circleci/config.yml

@@ -45,10 +45,10 @@ jobs:
           command: git clone --recurse-submodules https://github.com/apauley/hledger-flow-example.git $HOME/hledger-flow-example
       - run:
           name: hledger-flow import
-          command: ~/.local/bin/hledger-flow import --verbose $HOME/hledger-flow-example
+          command: ~/.local/bin/hledger-flow import --show-options --verbose $HOME/hledger-flow-example
       - run:
           name: hledger-flow report
-          command: ~/.local/bin/hledger-flow report --verbose $HOME/hledger-flow-example
+          command: ~/.local/bin/hledger-flow report --show-options --verbose $HOME/hledger-flow-example
       - run:
           name: Undo package.yaml change before cache_save
           command: git checkout HEAD package.yaml

.gitignore

@@ -1,7 +1,9 @@
 .stack-work/
+dist/
+dist-newstyle/
 hledger-flow.cabal
 *~
 scratch
 docs/my-finances
 releases/
-*.c.*
+*.c.*

.travis.yml

@@ -30,7 +30,6 @@ before_install:
   - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then sed -i 's/- -dynamic /- -static  /g' $TRAVIS_BUILD_DIR/package.yaml; fi
   - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then cat /proc/cpuinfo; fi
   - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then cat /proc/meminfo; fi
-  - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then sudo apt-get update && sudo apt install hledger; fi
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then sysctl -n machdep.cpu.brand_string; fi
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew update --verbose; fi
   - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew install --verbose haskell-stack hledger; fi
@@ -54,15 +53,16 @@ install:
   - hledger-flow version
   - ldd $(which hledger-flow) || true
   - ./bin/release-tarball ~/.local/bin/hledger-flow
+  - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then stack install hledger; fi
   - which hledger
   - hledger --version
   - git clone --recurse-submodules https://github.com/apauley/hledger-flow-example.git $HOME/hledger-flow-example
 
 script:
   - stack test --interleaved-output --ghc-options=-Werror
   - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then git checkout HEAD package.yaml; fi
-  - hledger-flow import --verbose $HOME/hledger-flow-example
-  - hledger-flow report --verbose $HOME/hledger-flow-example
+  - hledger-flow import --show-options --verbose $HOME/hledger-flow-example
+  - hledger-flow report --show-options --verbose $HOME/hledger-flow-example
 
 deploy:
   provider: releases

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

TODO.org

@@ -10,9 +10,6 @@
    - Overall reports, and reports per owner
    - More useful reports?
 ** Performance
-   - Generate reports in parallel
    - Don't re-process statements that have already been processed
 ** Documentation
    - Expand the step-by-step instructions with more scenarios
-** Random Thoughts
-   - First build a list of actions, then perform the actions

app/Main.hs

@@ -14,7 +14,13 @@ import Hledger.Flow.Common
 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,29 +32,34 @@ main = do
     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)
   <|> fmap Report (subcommand "report" "Generate Reports" subcommandParser)
   <|> 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")

bin/tag-release

@@ -7,5 +7,6 @@ BASEDIR="$(pwd)"
 GITHASH="$(git log -1 --format=tformat:%H)"
 PACKAGE_VERSION="$(grep '^version:' ${BASEDIR}/package.yaml|awk '{print $2}')"
 VERSION="v${PACKAGE_VERSION}-beta"
+MSG=$(echo -e "Release version ${PACKAGE_VERSION}\n\nSee ChangeLog for details - https://github.com/apauley/hledger-flow/blob/master/ChangeLog.md")
 
-git tag --sign --message="Release version ${PACKAGE_VERSION}" ${VERSION} ${GITHASH}
+git tag --sign --message="${MSG}" ${VERSION} ${GITHASH}

package.yaml

@@ -1,5 +1,5 @@
 name:                hledger-flow
-version:             0.11.1.1
+version:             0.11.1.2
 synopsis:            An hledger workflow focusing on automated statement import and classification.
 category:            Finance, Console
 license:             GPL-3

src/Hledger/Flow/CSVImport.hs

@@ -4,11 +4,11 @@ module Hledger.Flow.CSVImport
     ( 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 @@ importCSVs opts = sh (
   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 @@ pathSeparators = ['/', '\\', ':']
 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 @@ importCSVs' opts ch = do
       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,43 +74,46 @@ importCSV opts ch importDirs srcFile = do
   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
   let relCSV = relativeToBase opts csvSrc
   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 @@ statementSpecificRulesFiles csvSrc importDirs = do
       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