hledger-flow 0.11.1.2 → 0.11.2.0

raw patch · 7 files changed

+96/−50 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• README.org +15/−2
• hledger-flow.cabal +4/−4
• src/Hledger/Flow/CSVImport.hs +13/−15
• src/Hledger/Flow/Common.hs +53/−24
• src/Hledger/Flow/Reports.hs +4/−5
• src/Hledger/Flow/Types.hs +3/−0

@@ -1,5 +1,9 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.11.2++- Improved display of external process output+ ## 0.11.1.2  - Exit with an error code when any external script fails - https://github.com/apauley/hledger-flow/issues/28

@@ -38,6 +38,17 @@ with the ideas in [[https://github.com/adept/full-fledged-hledger/wiki][adept's Full-fledged Hledger]] aren't really specific to my own finances, and can be shared. +* How do I install it?+  :PROPERTIES:+  :CUSTOM_ID: how-do-i-install-it+  :END:++The easiest way to get it running is to download [[https://github.com/apauley/hledger-flow/releases][the latest release]]+for your OS, and copy the =hledger-flow= executable to a directory in your PATH.+Then just run it and see what it tells you to do.++You can also compile it yourself by following the [[#build-instructions][build instructions]].+ * Overview of the Basic Workflow   :PROPERTIES:   :CUSTOM_ID: overview-of-the-basic-workflow@@ -524,7 +535,7 @@ Save your =construct= script in the account directory, e.g. =import/john/mybank/savings/construct=. -=hledger-flow= will call your =construct= script with 4 positional+=hledger-flow= will call your =construct= script with 5 positional parameters:  1. The path to the input statement, e.g.@@ -540,8 +551,10 @@ - generate your own =hledger= journal transactions - be idempotent. Running =construct= multiple times on the same files   should produce the same result.-- send all output to =stdout=. =hledger-flow= will pipe your output into+- send all journals to =stdout=. =hledger-flow= will pipe your standard output into   =hledger= which will format it and save it to an output file.++You can still use =stderr= in your construct script for any other output that you may want to see.  *** Stability of this Feature     :PROPERTIES:

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: 752e52ff23c6e0069c279dc21baa46e6c8b0b20124b506e7bdca5d52136bb483+-- hash: 4192698e971b03566fe89299093f48fdb43d3a26f65a2ac17592ae7a294868c4  name:           hledger-flow-version:        0.11.1.2+version:        0.11.2.0 synopsis:       An hledger workflow focusing on automated statement import and classification. description:    Please see the README on GitHub at <https://github.com/apauley/hledger-flow#readme> category:       Finance, Console@@ -57,7 +57,7 @@   hs-source-dirs:       app   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fPIC-  ld-options: -dynamic+  ld-options: -static   build-depends:       base >=4.7 && <5     , hledger-flow

@@ -85,13 +85,11 @@ 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 = (parAwareProc opts) script' [format fp src, format fp csvOut, lineToText bank, lineToText account, lineToText owner] empty+  let args = [format fp src, format fp csvOut, lineToText bank, lineToText account, lineToText owner]   let relScript = relativeToBase opts script   let relSrc = relativeToBase opts src-  let msg = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc-  ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action-  channelOut ch stdOut+  let cmdLabel = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc+  _ <- timeAndExitOnErr opts ch cmdLabel channelOut channelErr (parAwareProc opts) (format fp script, args, empty)   return csvOut  hledgerImport :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO FilePath@@ -110,10 +108,9 @@     Just rf -> do       let relRules = relativeToBase opts rf       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-      ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action-      channelOut ch stdOut+      let args = ["print", "--rules-file", format fp rf, "--file", format fp csvSrc, "--output-file", format fp journalOut]+      let cmdLabel = format ("importing '"%fp%"' using rules file '"%fp%"'") relCSV relRules+      _ <- timeAndExitOnErr opts ch cmdLabel channelOut channelErr (parAwareProc opts) (hledger, args, empty)       return journalOut     Nothing ->       do@@ -157,12 +154,13 @@ 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 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 constructArgs = [format fp csvSrc, "-", lineToText bank, lineToText account, lineToText owner]+  let constructCmdText = format ("Running: "%fp%" "%s) relScript (showCmdArgs constructArgs)+  let stdLines = inprocWithErrFun (channelErrLn ch) (script, constructArgs, empty)+  let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text+  let args = ["print", "--ignore-assertions", "--file", "-", "--output-file", format fp journalOut]   let relSrc = relativeToBase opts csvSrc-  let msg = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc-  ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action-  channelOut ch stdOut+  let cmdLabel = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc+  _ <- timeAndExitOnErr' opts ch cmdLabel [constructCmdText] channelOut channelErr (parAwareProc opts) (hledger, args, stdLines)   return journalOut

@@ -9,12 +9,14 @@     , showCmdArgs     , consoleChannelLoop     , terminateChannelLoop+    , dummyLogger     , channelOut, channelOutLn     , channelErr, channelErrLn     , errExit     , logVerbose-    , timeAndExitOnErr+    , timeAndExitOnErr, timeAndExitOnErr'     , parAwareProc+    , inprocWithErrFun     , verboseTestFile     , relativeToBase     , relativeToBase'@@ -55,7 +57,7 @@ import Data.Time.LocalTime  import Data.Function (on)-import qualified Data.List as List (nub, sort, sortBy, groupBy)+import qualified Data.List as List (nub, null, sort, sortBy, groupBy) import Data.Ord (comparing) import Hledger.Flow.Types import qualified Hledger.Flow.Import.Types as IT@@ -103,6 +105,9 @@ escapeArg :: Text -> Text escapeArg a = if (T.count " " a > 0) then "'" <> a <> "'" else a +dummyLogger :: TChan LogMessage -> Text -> IO ()+dummyLogger _ _ = return ()+ channelOut :: TChan LogMessage -> Text -> IO () channelOut ch txt = atomically $ writeTChan ch $ StdOut txt @@ -153,41 +158,65 @@ logVerbose :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO () logVerbose opts ch msg = if (verbose opts) then logToChannel ch msg else return () -logTimedAction :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO FullOutput -> IO FullTimedOutput-logTimedAction opts ch msg action = do-  logVerbose opts ch $ format ("Begin: "%s) msg-  timed@((ec, _, _), diff) <- time action-  logVerbose opts ch $ format ("End:   "%s%" "%s%" ("%s%")") msg (repr ec) (repr diff)+descriptiveOutput :: Text -> Text -> Text+descriptiveOutput outputLabel outTxt = do+  if not (T.null outTxt)+    then format (s%":\n"%s%"\n") outputLabel outTxt+    else ""++logTimedAction :: HasVerbosity o => o -> TChan LogMessage -> Text -> [Text]+  -> (TChan LogMessage -> Text -> IO ()) -> (TChan LogMessage -> Text -> IO ())+  -> IO FullOutput+  -> IO FullTimedOutput+logTimedAction opts ch cmdLabel extraCmdLabels stdoutLogger stderrLogger action = do+  logVerbose opts ch $ format ("Begin: "%s) cmdLabel+  if (List.null extraCmdLabels) then return () else logVerbose opts ch $ T.intercalate "\n" extraCmdLabels+  timed@((ec, stdOut, stdErr), diff) <- time action+  stdoutLogger ch stdOut+  stderrLogger ch stdErr+  logVerbose opts ch $ format ("End:   "%s%" "%s%" ("%s%")") cmdLabel (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 ()+timeAndExitOnErr :: (HasSequential o, HasVerbosity o) => o -> TChan LogMessage -> Text+  -> (TChan LogMessage -> Text -> IO ()) -> (TChan LogMessage -> Text -> IO ())+  -> ProcFun -> ProcInput+  -> IO FullTimedOutput+timeAndExitOnErr opts ch cmdLabel = timeAndExitOnErr' opts ch cmdLabel []++timeAndExitOnErr' :: (HasSequential o, HasVerbosity o) => o -> TChan LogMessage -> Text -> [Text]+  -> (TChan LogMessage -> Text -> IO ()) -> (TChan LogMessage -> Text -> IO ())+  -> ProcFun -> ProcInput+  -> IO FullTimedOutput+timeAndExitOnErr' opts ch cmdLabel extraCmdLabels stdoutLogger stderrLogger procFun (cmd, args, stdInput) = do+  let action = procFun cmd args stdInput+  timed@((ec, stdOut, stdErr), _) <- logTimedAction opts ch cmdLabel extraCmdLabels stdoutLogger stderrLogger action   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 cmdText = format (s%" "%s) cmd $ showCmdArgs args+      let msgOut = descriptiveOutput "Standard output" stdOut+      let msgErr = descriptiveOutput "Error output" stdErr -      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+      let exitMsg = format ("\n=== Begin Error: "%s%" ===\nExternal command:\n"%s%"\nExit code "%d%"\n"+                            %s%s%"=== End Error: "%s%" ===\n") cmdLabel cmdText i msgOut msgErr cmdLabel       errExit i ch exitMsg timed     ExitSuccess -> return timed -procWithEmptyOutput :: MonadIO io => Text -> [Text] -> Shell Line -> io FullOutput+procWithEmptyOutput :: ProcFun 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 :: HasSequential o => o -> ProcFun parAwareProc opts = if (sequential opts) then procWithEmptyOutput else procStrictWithErr++inprocWithErrFun :: (Text -> IO ()) -> ProcInput -> Shell Line+inprocWithErrFun errFun (cmd, args, standardInput) = do+  result <- inprocWithErr cmd args standardInput+  case result of+    Right ln -> return ln+    Left  ln -> do+      (liftIO . errFun . lineToText) ln+      empty  verboseTestFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> IO Bool verboseTestFile opts ch p = do

@@ -60,11 +60,10 @@   let reportArgs = ["--file", format fp journal] ++ args   let reportDisplayArgs = ["--file", format fp relativeJournal] ++ args   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, _), _) <- timeAndExitOnErr opts ch cmd action+  let cmdLabel = format ("hledger "%s) $ showCmdArgs reportDisplayArgs+  result@((exitCode, stdOut, _), _) <- timeAndExitOnErr opts ch cmdLabel dummyLogger channelErr procStrictWithErr (hledger, reportArgs, empty)   if not (T.null stdOut) then do-    writeTextFile outputFile (cmd <> "\n\n"<> stdOut)+    writeTextFile outputFile (cmdLabel <> "\n\n"<> stdOut)     channelOutLn ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile-    else channelErrLn ch $ format ("No report output for '"%s%"' "%s) cmd (repr exitCode)+    else channelErrLn ch $ format ("No report output for '"%s%"' "%s) cmdLabel (repr exitCode)   return (outputFile, result)

@@ -11,6 +11,9 @@ type FullOutput = (ExitCode, Text, Text) type FullTimedOutput = (FullOutput, NominalDiffTime) +type ProcFun = Text -> [Text] -> Shell Line -> IO FullOutput+type ProcInput = (Text, [Text], Shell Line)+ data HledgerInfo = HledgerInfo { hlPath :: FilePath                                , hlVersion :: Text                                }