packages feed

hledger-flow 0.17.0 → 0.18.0

raw patch · 20 files changed

+772/−1380 lines, 20 filesdep +code-page

Dependencies added: code-page

Files

ChangeLog.md view
@@ -1,23 +1,71 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow)  <!---How to keep this ChangeLog. The first section is always "## Unreleased".+How to keep this ChangeLog -- Add or update an entry in the same commit as any change a user could notice:-  behaviour, options, output, generated files, platforms, installation or-  build requirements, and the Hackage library API.-- Write from the user's point of view: what changes for them, and how it-  affects or benefits them. Use the names they see (commands, options, files,-  output), not how it was implemented.-- Order entries by impact on users, highest first:+- During development, keep "## Unreleased" first and leave it empty until+  something changes for someone installing, building or running the+  hledger-flow executable. Add or update the entry in the same commit as+  the change.+- Say what users can now do, what behaves differently or what action they+  need to take. Name the affected platform, command, option, file or output+  when it helps readers recognise the change.+- Keep each entry brief. Put commands and step-by-step instructions in the+  relevant guide. Link directly to that section when readers need details.+  Use a full URL so the link also works in the GitHub release notes.+- Keep one entry per user-visible change. If several changes add ways to do+  the same thing, update the existing entry. For example, list new installation+  options together and link each option to its instructions.+- Order entries by impact on users, highest first.   1. Changes users must act on, saying what they need to do.   2. New features and capabilities.   3. Behaviour changes and fixes, the most noticeable first.   4. Build, packaging and dependency changes.-- Keep one entry per change. Update an existing entry rather than adding-  another, and merge entries that describe the same change.-- Leave out changes users can't notice, such as refactoring, tests and CI.+- Skip changes that affect only maintainers, such as refactoring, changes+  to the internal Haskell API, test infrastructure, CI or release automation.+  hledger-flow supports only users who run the executable, not library users. A new Windows download belongs+  here because Windows users can install it. Automating publication to an+  existing destination belongs in release-procedure.md. -->++## 0.18.0++- If you keep handwritten transactions in a journal under `3-journal`+  without a matching input in `1-in`, move them to `_manual_`. `import`+  now treats `1-in` as the sole source of generated files. After+  successful conversion, orphaned preprocessed CSVs and journals in the+  selected account/year scope move to `.trash` instead of being counted+  again after an input is renamed or removed. Add `.trash/` to your+  `.gitignore`. See [generated files and recovery](https://github.com/apauley/hledger-flow/blob/master/docs/README.md#generated-files-and-recovery).+  Fixes [#108](https://github.com/apauley/hledger-flow/issues/108).+- Windows imports and reports now use UTF-8, including for account names+  such as `Morgan’s Current`. If your CSV statements use a legacy encoding,+  specify it in their rules file. Run `chcp 65001` before using standalone+  `hledger` to read the generated journals on Windows.+- You can now install hledger-flow on macOS and Linux with [Homebrew](https://github.com/apauley/hledger-flow/blob/master/README.md#install-with-homebrew).+  Each binary archive now includes a [quick-start](https://github.com/apauley/hledger-flow/blob/master/QUICKSTART.md)+  covering installation, download verification and a first import.+- Windows imports now run `preprocess.ps1` and `construct.ps1` directly+  with PowerShell. Native hooks can use `preprocess.exe` and `construct.exe`.+  Existing extensionless hooks take precedence. See+  [Windows import hooks](https://github.com/apauley/hledger-flow/blob/master/docs/README.md#windows-import-hooks).+- Manual-only years and ledgers now get include files without dummy inputs,+  including `_manual_` files at the import, owner, bank, and account levels.+  Fixes [#103](https://github.com/apauley/hledger-flow/issues/103).+- Owner reports now load `directives.journal` when present, so custom account+  types and currency formatting apply to individual owners as well as combined+  reports. Fixes [#112](https://github.com/apauley/hledger-flow/issues/112).+- Imports and reports now find `hledger` through relative `PATH` entries+  such as `.` and `../bin`, including symlinked executables.+  Fixes [#95](https://github.com/apauley/hledger-flow/issues/95).+- Imports reject input filenames that produce the same generated output+  before converting or moving files.+- Parallel imports and reports now stop the current batch when any task+  fails, even if an earlier task is still waiting on an external command.+- Commands printed in reports now preserve apostrophes and shell-special+  characters in filenames when replayed in a POSIX shell or Git Bash.+- The Windows executable now shows its product name and version in its+  file properties.  ## 0.17.0 
README.md view
@@ -2,93 +2,147 @@  ## What is it? -`hledger-flow` is a command-line program that gives you a guided [Hledger](https://hledger.org/)-workflow. It is important to note that most of the heavy lifting is done by the-upstream `hledger` project. For example, `hledger-flow` cares about where you-put your files for long-term maintainability, but the actual conversion to-classified accounting journals is done by `hledger`.+hledger-flow organises bank statements by owner, bank, account and year.+It uses [hledger](https://hledger.org/) and its CSV rules to generate one+journal per statement, then includes those journals and your manual entries+in `all-years.journal`. You keep the original statements so you can rebuild+the imported entries when your rules change. -`hledger-flow` focuses on automated processing of electronic statements as much as possible,-as opposed to manually adding your own hledger journal entries. Manual entries-are still possible, it just saves time in the long run to automatically process-a statement whenever one is available.+It grew out of scripts I wrote while using+[adept's Full-fledged Hledger](https://github.com/adept/full-fledged-hledger/wiki). -Within `hledger-flow` you will keep your original bank statements around-permanently as input, and generate (h)ledger journals each time-you run the program. The classification is done with [hledger's rules files](https://hledger.org/csv.html),-and/or your own script hooks.+## Who should use this? -Keeping the original statements means that you never have to worry too-much about "am I doing this accounting thing right?" or "what happens if-I make a mistake?". If you want to change your mind about some-classification, or if you made a mistake, you just change your-classification rules, and run the program again.+**Choose hledger-flow** if you keep non-overlapping statements and want to+apply better rules to several years of transactions. It is especially useful+when you manage several accounts or owners and want to review the changes+to each statement's journal before committing them. -It started when I realized that the scripts I wrote while playing around with-[adept's Full-fledged Hledger](https://github.com/adept/full-fledged-hledger/wiki) aren't really specific to my own finances, and can-be shared.+**Choose plain `hledger import`** if you want to append new transactions+and then review, split or annotate them directly in your journal. Your edits+survive the next import. This also suits rolling downloads such as “the last+90 days” from the same account. hledger remembers how far it got for each+source, which works well when dates and the order of same-day transactions+are stable. hledger-flow processes each statement independently, so overlapping+files can count the same purchase twice. You can keep the original CSVs with+either workflow. See [hledger's import guide](https://hledger.org/dev/hledger.html#import).  ## Overview of the Basic Workflow -1.  Save an input transaction file (typically CSV) to a [specific directory](docs/README.md#input-files).-2.  Add an hledger [rules file](docs/README.md#rules-files).-    Include some classification rules if you want.-3.  Run `hledger-flow import`+1. Save each statement under its [account and year](docs/README.md#input-files).+2. Add an [hledger rules file](docs/README.md#rules-files) for the account or bank.+   For most bank CSVs, rules are all you need.+3. Run `hledger-flow import` from the base directory. Use the generated+   `all-years.journal` as your `LEDGER_FILE`.+4. Commit the statements, rules, manual journals and generated journals to+   version control so you can review the effect of later rule changes. -Add all your files to your favourite version control system.+### Example: reclassify purchases across three years -The generated journal that you most likely want to use as your-`LEDGER_FILE` is called `all-years.journal`. This has include directives-to all the automatically imported journals, as well as includes for your-own manually managed journal entries.+Suppose your 2023–2025 statements are already imported and committed.+Purchases from City Rail currently appear under `expenses:misc`. You also+recorded a one-off cash fare by hand in+`import/john/_manual_/2024/post-import.journal`. Keep handwritten adjustments+in a [manual journal](docs/README.md#manually-managed-journals), since each+full import rewrites the statement journals in `3-journal/`. -In a typical software project we don't add generated files to version-control, but in this case I think it is a good idea to add all the-generated files to version control as well - when you inevitably change-something, e.g. how you classify transactions in your rules file, then-you can easily see if your change had the desired effect by looking at a-diff.+Add this rule to `import/mybank.rules`, the rules file used by those statements: -## Who should use this?+```rules+if %description City Rail+  account2 expenses:transport+``` -`hledger-flow` is intended for you if:+From the base directory, rebuild all three years and review the changes: -- You want a way to organise your finances into a structure that will be-  maintainable over the long term.-- You like the idea of treating your source transactions (typically CSV files)-  as input, and having your hledger journals (mostly) being generated as output.-- You want to automate as much as possible when dealing with your-  financial life.-- You don't mind writing some scripts when needed, as long as it saves-  you time over the long term.+```sh+hledger-flow import+git diff -- import/+hledger -f all-years.journal print expenses:transport+``` +The diff should show the rule and the matching purchases moving from+`expenses:misc` to `expenses:transport` in each affected statement journal.+The cash fare stays in the manual journal. If you booked it to+`expenses:transport`, the last command shows it alongside the rebuilt entries.+ ## How do I install it? -If you can compile it yourself, please do so by following the [build instructions](https://github.com/apauley/hledger-flow/blob/master/CONTRIBUTING.md#build-the-project).+| Installation method | Platforms | Choose this if you want to… |+| --- | --- | --- |+| [Download a GitHub release](#download-a-github-release) | Windows, macOS, Linux | Run a prebuilt executable. |+| [Install with Homebrew](#install-with-homebrew) | macOS, Linux | Install and upgrade with `brew`. |+| [Build from source](#build-from-source) | Windows, macOS, Linux | Compile the project yourself with Stack. | -Otherwise download [the latest release](https://github.com/apauley/hledger-flow/releases) for your OS, extract the archive, and copy the `hledger-flow` executable (`hledger-flow.exe` on Windows) to a directory in your PATH.+### Download a GitHub release -On Mac you may see a warning.+1. Download the archive for your OS and processor from the [latest GitHub release](https://github.com/apauley/hledger-flow/releases/latest).+2. Extract it and copy `hledger-flow` (or `hledger-flow.exe` on Windows) to a directory on your `PATH`.+   On macOS, [extract and run it from your terminal](QUICKSTART.md#install-on-macos), not Finder.+3. [Install hledger](https://hledger.org/install.html) for imports and reports. -Install `hledger` separately and ensure it is on `PATH`, or supply-`--hledger-path`. Account-specific `preprocess` and `construct` scripts need-an available interpreter; on Windows, Unix shell scripts may need adapting.+The [quick-start guide](QUICKSTART.md) lists the archive names and walks through installation and your first import on each platform. -### Verifying a download+#### Verifying a download -Releases from 0.17 onwards are immutable and attested by GitHub. With the-[GitHub CLI](https://cli.github.com/), check that a downloaded archive is the-one published in the release, and that it was built by this project's GitHub-Actions workflow from the release tag:+From v0.17.0 onward, GitHub releases are immutable and the archives carry build+attestations. To verify a download, substitute its release tag and archive name+in both [GitHub CLI](https://cli.github.com/) commands: -``` bash+```sh gh release verify-asset v0.17.0 hledger-flow-macos-arm64.tar.gz -R apauley/hledger-flow gh attestation verify hledger-flow-macos-arm64.tar.gz -R apauley/hledger-flow ``` -The macOS binaries are also signed with a Developer ID and notarized by Apple.+The first command checks that the archive matches the published release. The+second checks its build provenance. The macOS binaries are signed with a+Developer ID and submitted to Apple for notarization. +### Install with Homebrew++On a [supported Mac or Linux system](https://github.com/FernTrail/homebrew-tap#supported-platforms),+check that `brew --version` works in your terminal. If you’re new to Homebrew,+[install Homebrew](https://brew.sh/) and follow the installer’s instructions to add `brew` to your `PATH`.++To set up FernTrail’s package repository (its *tap*) for the first time:++```sh+brew tap ferntrail/tap+```++Optionally, to inspect the package before installing it, trust just the+hledger-flow formula and show its details (Homebrew 6 or newer):++```sh+brew trust --formula ferntrail/tap/hledger-flow+brew info ferntrail/tap/hledger-flow+```++Install hledger-flow and its `hledger` dependency:++```sh+brew install ferntrail/tap/hledger-flow+```++If you don’t want Homebrew to install `hledger`, add `--without-hledger` to the install command.+The fully qualified install command also works on its own: Homebrew adds the tap+automatically and trusts only the named formula. See [Homebrew’s tap trust guide](https://docs.brew.sh/Tap-Trust).++For later releases, run `brew update` and `brew upgrade ferntrail/tap/hledger-flow`.++### Build from source++From a checkout of this repository, run `stack install`. Add the directory+reported by `stack path --local-bin` to your `PATH` and [install hledger](https://hledger.org/install.html).+See the [build instructions](CONTRIBUTING.md#build-the-project) for prerequisites and tests.+ ## Getting Started++Check that both commands are available with `hledger-flow --version` and+`hledger --version`. To select a specific copy of hledger, use+`hledger-flow --hledger-path /path/to/hledger import`. Windows users can+write account hooks in PowerShell (`preprocess.ps1` and `construct.ps1`)+or use native executables. See [Windows import hooks](docs/README.md#windows-import-hooks).  Have a look at the [detailed step-by-step instructions](step-by-step/README.md) and the [feature reference](docs/README.md). 
app/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -41,6 +42,9 @@ import Hledger.Flow.Import.CSVImport ( importCSVs )  import qualified Data.Text.IO as T+#ifdef mingw32_HOST_OS+import System.IO.CodePage (withCP65001)+#endif  data ImportParams = ImportParams { maybeImportBaseDir :: Maybe FilePath                                  , importStartYear :: Maybe String@@ -63,7 +67,16 @@ data BaseCommand = Version | Command { mainParams :: MainParams, command :: Command } deriving (Show)  main :: IO ()-main = do+#ifdef mingw32_HOST_OS+-- hledger inherits the console code page; generated journals, pipes and+-- diagnostics must use the same encoding for the whole run.+main = withCP65001 runCLI+#else+main = runCLI+#endif++runCLI :: IO ()+runCLI = do   let description = "An hledger workflow focusing on automated statement import and classification:\nhttps://github.com/apauley/hledger-flow#readme"   cmd <- customExecParser (prefs (showHelpOnError <> showHelpOnEmpty))     (info (helper <*> baseCommandParser) (headerDoc (Just description)))
hledger-flow.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hledger-flow-version:        0.17.0+version:        0.18.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@@ -34,6 +34,7 @@       Hledger.Flow.Import.CSVImport       Hledger.Flow.Import.ImportHelpers       Hledger.Flow.Import.ImportHelpersTurtle+      Hledger.Flow.Import.Inventory       Hledger.Flow.Import.Types       Hledger.Flow.Internals       Hledger.Flow.Logging@@ -78,6 +79,9 @@     , path >=0.9.6 && <0.10     , text >=2.1.3 && <2.2   default-language: Haskell2010+  if os(windows)+    build-depends:+        code-page >=0.2.1 && <0.3  test-suite hledger-flow-test   type: exitcode-stdio-1.0@@ -93,7 +97,6 @@       ImportHelpers.Integration       PathHelpers.Unit       TestHelpers-      TestHelpersTurtle       Paths_hledger_flow   hs-source-dirs:       test
src/Hledger/Flow/Common.hs view
@@ -6,9 +6,9 @@ import Control.Concurrent (threadDelay) import Control.Monad (filterM, forM_, when) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Concurrent.Async (concurrently, wait, withAsync)+import Control.Concurrent.Async (concurrently, mapConcurrently) import Control.Concurrent.STM-import Data.Char (isDigit)+import Data.Char (isAlphaNum, isAscii, isDigit) import Data.Either import Data.Function (on) import qualified Data.List as List (groupBy, isPrefixOf, isSuffixOf, null, sortBy)@@ -19,7 +19,6 @@ import qualified Data.Text.IO as T import qualified Data.Text.Read as T import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)-import Foreign.Marshal.Utils (withMany) import qualified GHC.IO.Handle.FD as H import Hledger.Flow.DateTime (timeAction) import Hledger.Flow.BaseDir (relativeToBase)@@ -34,6 +33,7 @@ import qualified System.FilePath as FilePath import System.Exit (ExitCode (..), exitWith) import System.IO (hClose)+import qualified System.Info as Sys import qualified System.Process as Process import System.IO.Error (tryIOError) import System.FilePath ((<.>))@@ -51,9 +51,10 @@           let msg = "Unable to find hledger at " <> T.pack h           errExit' 1 (T.hPutStrLn H.stderr) msg hlAbs     Nothing -> do-      maybeH <- Path.findExecutable [relfile|hledger|]+      maybeH <- Directory.findExecutable "hledger"       case maybeH of-        Just h -> return h+        -- Relative PATH entries can produce relative executable paths.+        Just h -> Path.resolveFile' h         Nothing -> do           let msg =                 "Unable to find hledger in your path.\n"@@ -90,7 +91,11 @@ showCmdArgs args = T.intercalate " " (map escapeArg args)  escapeArg :: T.Text -> T.Text-escapeArg a = if T.count " " a > 0 then "'" <> a <> "'" else a+escapeArg a+  | not (T.null a) && T.all safe a = a+  | otherwise = "'" <> T.replace "'" "'\"'\"'" a <> "'"+  where+    safe c = isAscii c && (isAlphaNum c || c `elem` ("-_./:=+,@%" :: String))  errExit :: Int -> TChan LogMessage -> T.Text -> a -> IO a errExit exitStatus ch = errExit' exitStatus (channelErrLn ch)@@ -133,7 +138,10 @@ runProcessCaptured :: ProcInput -> IO FullOutput runProcessCaptured (cmd, args, input) = do   let process = (Process.proc (T.unpack cmd) (map T.unpack args))-        { Process.std_in = maybe Process.CreatePipe Process.UseHandle input,+        { -- With all three streams redirected, process otherwise starts a+          -- Windows child without our console, losing its UTF-8 code page.+          Process.create_group = Sys.os == "mingw32",+          Process.std_in = maybe Process.CreatePipe Process.UseHandle input,           Process.std_out = Process.CreatePipe,           Process.std_err = Process.CreatePipe         }@@ -193,8 +201,8 @@     runBatches [] = return []     runBatches actions = do       let (current, remaining) = splitAt batch actions-      -- Start the whole batch, then collect results and exceptions in input order.-      results <- withMany withAsync current (mapM wait)+      -- Keep result order, but cancel the batch as soon as any action fails.+      results <- mapConcurrently id current       (results ++) <$> runBatches remaining  verboseTestFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> AbsFile -> IO Bool@@ -273,21 +281,6 @@ writeTextMap files = forM_ (Map.toList files) $ \(path, contents) -> do   current <- tryIOError (T.readFile path)   when (either (const True) (/= contents) current) $ T.writeFile path contents--changeExtension :: T.Text -> FilePath -> FilePath-changeExtension ext path = (FilePath.dropExtension path) <.> (T.unpack ext)--changePathAndExtension :: FilePath -> T.Text -> FilePath -> FilePath-changePathAndExtension newOutputLocation newExt = (changeOutputPath newOutputLocation) . (changeExtension newExt)--changeOutputPath :: FilePath -> FilePath -> FilePath-changeOutputPath newOutputLocation = concatMap changeSrcDir . FilePath.splitPath-  where-    changeSrcDir "." = "./"-    changeSrcDir ".." = "../"-    changeSrcDir part-      | FilePath.dropTrailingPathSeparator part `elem` ["1-in", "2-preprocessed"] = newOutputLocation-      | otherwise = part  listOwners :: HasBaseDir o => o -> IO [RelDir] listOwners opts = do
src/Hledger/Flow/Import/CSVImport.hs view
@@ -8,7 +8,8 @@  import Control.Concurrent.STM import Control.Monad-import Data.Maybe (fromMaybe, isNothing)+import Data.Maybe (fromMaybe)+import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Data.Text.IO as T import Hledger.Flow.DateTime (timeAction)@@ -16,18 +17,21 @@ import Hledger.Flow.Common import Hledger.Flow.DocHelpers (docURL) import Hledger.Flow.Import.ImportHelpers-import Hledger.Flow.Import.ImportHelpersTurtle (writeIncludesUpTo, writeToplevelAllYearsInclude)+import Hledger.Flow.Import.ImportHelpersTurtle (writeIncludesFromInventory, writeToplevelAllYearsInclude)+import Hledger.Flow.Import.Inventory import Hledger.Flow.Import.Types import Hledger.Flow.Logging-import Hledger.Flow.PathHelpers (AbsFile, RelDir)+import Hledger.Flow.PathHelpers (AbsFile) import Hledger.Flow.RuntimeOptions import qualified Hledger.Flow.Types as FlowTypes import qualified Path import qualified Path.IO as PathIO+import System.Environment (getEnv) import System.Exit (ExitCode (..), exitWith) import System.IO (hClose)+import qualified System.Info as Sys import qualified System.Process as Process-import System.FilePath (dropExtensions, dropTrailingPathSeparator, replaceExtension, (<.>))+import System.FilePath (dropExtensions, dropTrailingPathSeparator, takeExtension, (<.>), (</>)) import Prelude hiding (putStrLn, take, writeFile)  type FileWasGenerated = Bool@@ -43,31 +47,43 @@ importCSVs' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [(AbsFile, FileWasGenerated)] importCSVs' opts ch = do   let effectiveDir = effectiveRunDir (baseDir opts) (importRunDir opts)+      importRoot = baseDir opts Path.</> [Path.reldir|import|]+      selected = inImportScope effectiveDir (fromMaybe 0 (importStartYear opts))   let startYearMsg = maybe " " (\y -> " (for the year " <> T.pack (show y) <> " and onwards) ") (importStartYear opts)   let dirText = T.pack (Path.toFilePath effectiveDir)   channelOutLn ch $ "Collecting input files" <> startYearMsg <> "from " <> dirText-  (inputFiles, diff) <- timeAction $ findInputFiles (fromMaybe 0 $ importStartYear opts) effectiveDir+  (inventory, diff) <- timeAction $ findImportFiles importRoot+  let inputFiles = filter selected (stageFiles importRoot [Path.reldir|1-in|] inventory)+      fileCount = length inputFiles+  collisions <- conflictingOutputs inputFiles+  let relative = T.pack . relativeToBase opts . Path.toFilePath+  unless (null collisions) $+    errExit 1 ch ("Multiple input files map to the same output:\n" <>+      T.intercalate "\n" [relative output <> " <- " <> T.intercalate ", " (map relative sources)+                         | (output, sources) <- collisions]) ()+  channelOutLn ch $ "Found " <> T.pack (show fileCount) <> " input files" <> startYearMsg <> "in " <> T.pack (show diff) <> ". Proceeding with import..."+  importedJournals <- parAwareActions opts (map (extractAndImport opts ch) inputFiles) -  let fileCount = length inputFiles-  if fileCount == 0 && isNothing (importStartYear opts)-    then do-      let msg =-            "I couldn't find any input files underneath " <> dirText-              <> "\n\nhledger-flow expects to find its input files in specifically\nnamed directories.\n\n"-              <> "Have a look at the documentation for a detailed explanation:\n"-              <> docURL "input-files"-      errExit 1 ch msg []-    else do-      channelOutLn ch $ "Found " <> T.pack (show fileCount) <> " input files" <> startYearMsg <> "in " <> T.pack (show diff) <> ". Proceeding with import..."-      let actions = map (extractAndImport opts ch) inputFiles-      importedJournals <- parAwareActions opts actions-      let importRoot = baseDir opts Path.</> [Path.reldir|import|]-      (journalsOnDisk, journalFindTime) <- timeAction $ findJournalFiles importRoot-      (_, writeIncludeTime1) <- timeAction $ writeIncludesUpTo opts ch importRoot journalsOnDisk-      (_, writeIncludeTime2) <- timeAction $ writeToplevelAllYearsInclude opts-      let includeGenTime = journalFindTime + writeIncludeTime1 + writeIncludeTime2-      channelOutLn ch $ "Wrote include files for " <> T.pack (show (length journalsOnDisk)) <> " journals in " <> T.pack (show includeGenTime)-      return importedJournals+  -- Hooks may create files, so reconcile against a fresh inventory only after+  -- every selected conversion succeeds. A cached CSV is never a source.+  (refreshed, journalFindTime) <- timeAction $ findImportFiles importRoot+  expected <- expectedOutputs (stageFiles importRoot [Path.reldir|1-in|] refreshed)+  let stageWithExtension stage ext = filter ((== ext) . takeExtension . Path.toFilePath) (stageFiles importRoot stage refreshed)+      journals = stageWithExtension [Path.reldir|3-journal|] ".journal"+      generated = stageWithExtension [Path.reldir|2-preprocessed|] ".csv" ++ journals+  classified <- forM generated $ \file -> do+    key <- canonicalFile file+    return (file, Map.member key expected)+  let orphans = [file | (file, False) <- classified, selected file]+      journalsOnDisk = [file | (file, True) <- classified, takeExtension (Path.toFilePath file) == ".journal"]+  forM_ orphans $ \file -> do+    target <- moveToTrash file+    channelOutLn ch $ "Moved orphaned output " <> relative file <> " to " <> relative target+  (_, writeIncludeTime1) <- timeAction $ writeIncludesFromInventory opts ch importRoot refreshed journalsOnDisk+  (_, writeIncludeTime2) <- timeAction $ writeToplevelAllYearsInclude opts+  let includeGenTime = journalFindTime + writeIncludeTime1 + writeIncludeTime2+  channelOutLn ch $ "Wrote include files for " <> T.pack (show (length journalsOnDisk)) <> " generated journals in " <> T.pack (show includeGenTime)+  return importedJournals  extractAndImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> AbsFile -> IO (AbsFile, FileWasGenerated) extractAndImport opts ch inputFile = do@@ -78,9 +94,9 @@  importCSV :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs Path.Abs -> AbsFile -> IO (AbsFile, FileWasGenerated) importCSV opts ch importDirs srcFile = do-  csvOut <- outputFile importDirs [Path.reldir|2-preprocessed|] ".csv" srcFile+  csvOut <- generatedOutput [Path.reldir|2-preprocessed|] ".csv" srcFile   (csvFile, preprocessHappened) <- preprocessIfNeeded opts ch importDirs srcFile csvOut-  journalOut <- outputFile importDirs [Path.reldir|3-journal|] ".journal" csvFile+  journalOut <- generatedOutput [Path.reldir|3-journal|] ".journal" csvFile   shouldImport <-     if onlyNewFiles opts && not preprocessHappened       then needsRegeneration csvFile journalOut@@ -88,40 +104,58 @@   PathIO.createDirIfMissing True (Path.parent journalOut)   if shouldImport     then do-      let script = accountDir importDirs Path.</> [Path.relfile|construct|]-      hasConstruct <- verboseTestFile opts ch script-      if hasConstruct-        then withStagedOutput journalOut (customConstruct opts ch script importDirs csvFile)-        else hledgerImport opts ch importDirs csvFile journalOut+      hook <- findHook opts ch (accountDir importDirs Path.</> [Path.relfile|construct|])+      case hook of+        Just script -> withStagedOutput journalOut (customConstruct opts ch script importDirs csvFile)+        Nothing -> hledgerImport opts ch importDirs csvFile journalOut     else logNewFileSkip opts ch "import" journalOut   return (journalOut, shouldImport) -outputFile :: ImportDirs Path.Abs -> RelDir -> String -> AbsFile -> IO AbsFile-outputFile dirs stage ext source = do-  name <- Path.parseRelFile (replaceExtension (Path.toFilePath (Path.filename source)) ext)-  return (accountDir dirs Path.</> stage Path.</> Path.dirname (yearDir dirs) Path.</> name)- preprocessIfNeeded :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs Path.Abs -> AbsFile -> AbsFile -> IO (AbsFile, Bool) preprocessIfNeeded opts ch dirs src csvOut = do-  let script = accountDir dirs Path.</> [Path.relfile|preprocess|]-  scriptExists <- verboseTestFile opts ch script-  targetExists <- verboseTestFile opts ch csvOut-  shouldProceed <--    if onlyNewFiles opts && scriptExists-      then do-        needsRegen <- needsRegeneration src csvOut-        Control.Monad.unless needsRegen $ logNewFileSkip opts ch "preprocess" csvOut-        return needsRegen-      else return scriptExists-  if shouldProceed-    then do-      withStagedOutput csvOut (preprocess opts ch script dirs src)-      return (csvOut, True)-    else do-      if targetExists-        then return (csvOut, False)-        else return (src, False)+  hook <- findHook opts ch (accountDir dirs Path.</> [Path.relfile|preprocess|])+  case hook of+    Nothing -> do+      cached <- verboseTestFile opts ch csvOut+      return (if cached then csvOut else src, False)+    Just script -> do+      regenerate <- if onlyNewFiles opts then needsRegeneration src csvOut else return True+      if regenerate+        then withStagedOutput csvOut (preprocess opts ch script dirs src)+        else logNewFileSkip opts ch "preprocess" csvOut+      return (csvOut, regenerate) +findHook :: RuntimeOptions -> TChan FlowTypes.LogMessage -> AbsFile -> IO (Maybe AbsFile)+findHook opts ch base = do+  alternatives <- if Sys.os == "mingw32"+    then mapM (`Path.addExtension` base) [".ps1", ".exe"]+    else return []+  first (base : alternatives)+  where+    first [] = return Nothing+    first (file : rest) = do+      exists <- verboseTestFile opts ch file+      if exists then return (Just file) else first rest++hookCommand :: AbsFile -> [T.Text] -> IO (T.Text, [T.Text])+hookCommand script args+  | Sys.os == "mingw32" && takeExtension path == ".ps1" = do+      root <- getEnv "SystemRoot"+      let shell = root </> "System32" </> "WindowsPowerShell" </> "v1.0" </> "powershell.exe"+      -- Windows PowerShell -File treats construct's literal "-" as an option.+      -- Invoke the script with literal strings and propagate its exit status.+      let command = "[Console]::OutputEncoding = New-Object Text.UTF8Encoding($false); & "+            <> T.unwords (map literal (T.pack path : args))+            <> "; if (!$?) { if ($LASTEXITCODE) { exit $LASTEXITCODE }; exit 1 }"+      return (T.pack shell, ["-NoProfile", "-NonInteractive", "-OutputFormat", "Text", "-Command", command])+  | otherwise = return (T.pack path, args)+  where+    path = Path.toFilePath script+    -- PowerShell also recognises typographic single quotes as delimiters.+    literal s = "'" <> T.concatMap escape s <> "'"+    escape c | c == '\'' || (c >= '\x2018' && c <= '\x201b') = T.replicate 2 (T.singleton c)+             | otherwise = T.singleton c+ logNewFileSkip :: RuntimeOptions -> TChan FlowTypes.LogMessage -> T.Text -> AbsFile -> IO () logNewFileSkip opts ch logIdentifier absTarget =   Control.Monad.when (onlyNewFiles opts) $ do@@ -135,7 +169,8 @@   let relScript = relativeToBase opts (Path.toFilePath script)   let relSrc = relativeToBase opts (Path.toFilePath src)   let cmdLabel = "executing '" <> T.pack relScript <> "' on '" <> T.pack relSrc <> "'"-  _ <- timeAndExitOnErr opts ch cmdLabel channelOut channelErr (T.pack (Path.toFilePath script), args, Nothing)+  (cmd, hookArgs) <- hookCommand script args+  _ <- timeAndExitOnErr opts ch cmdLabel channelOut channelErr (cmd, hookArgs, Nothing)   return ()  hledgerImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs Path.Abs -> AbsFile -> AbsFile -> IO ()@@ -197,7 +232,8 @@   let relScript = relativeToBase opts (Path.toFilePath constructScript)   let constructArgs = [T.pack csvSrc, "-"] ++ hookDirArgs dirs   let constructCmdText = "Running: " <> T.pack relScript <> " " <> showCmdArgs constructArgs-  let hook = (Process.proc (Path.toFilePath constructScript) (map T.unpack constructArgs))+  (cmd, hookArgs) <- hookCommand constructScript constructArgs+  let hook = (Process.proc (T.unpack cmd) (map T.unpack hookArgs))         { Process.std_in = Process.CreatePipe, Process.std_out = Process.CreatePipe }   let hledger = T.pack (Path.toFilePath (FlowTypes.hlPath (hledgerInfo opts)))   let args =
src/Hledger/Flow/Import/ImportHelpers.hs view
@@ -1,16 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -module Hledger.Flow.Import.ImportHelpers (withStagedOutput, extractImportDirs, findInputFiles, findJournalFiles, groupIncludesUpTo, includeFileName) where+module Hledger.Flow.Import.ImportHelpers (withStagedOutput, extractImportDirs, groupIncludesUpTo, includeFileName) where -import Data.Char (isDigit) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T import Hledger.Flow.Common (groupValuesBy) import Hledger.Flow.DocHelpers (docURL) import Hledger.Flow.Import.Types (ImportDirs (..), InputFileBundle)-import Hledger.Flow.PathHelpers (AbsDir, AbsFile, RelDir, RelFile, findFilesInWith, pathSize)+import Hledger.Flow.PathHelpers (AbsFile, RelDir, RelFile, pathSize) import Path import qualified Path.IO as PathIO import System.FilePath (dropTrailingPathSeparator)@@ -42,37 +41,6 @@       <> "import/owner/bank/account/filestate/year/trxfile\n\n"       <> "Have a look at the documentation for a detailed explanation:\n"       <> docURL "input-files"--findInputFiles :: Integer -> AbsDir -> IO [AbsFile]-findInputFiles startYear = do-  let excludeDirs = excludeStageDirs [[reldir|2-preprocessed|], [reldir|3-journal|]]-  findFilesInWith (includeYearFilesForParent [reldir|1-in|] startYear) excludeDirs--findJournalFiles :: AbsDir -> IO [AbsFile]-findJournalFiles = do-  let excludeDirs = excludeStageDirs [[reldir|1-in|], [reldir|2-preprocessed|]]-  findFilesInWith (includeYearFilesForParent [reldir|3-journal|] 0) excludeDirs---- | Include only files directly underneath parentDir/yearDir, e.g. 1-in/2020/* or 3-journal/2020/*-includeYearFilesForParent :: RelDir -> Integer -> AbsDir -> Bool-includeYearFilesForParent parentDir startYear d =-  (dirname . parent) d == parentDir-    && length shortDirName == 4-    && all isDigit shortDirName-    && read shortDirName >= startYear-  where-    shortDirName = dirToStringNoSlash d--dirToStringNoSlash :: AbsDir -> String-dirToStringNoSlash = init . Path.toFilePath . Path.dirname---- Stage names are reserved only directly below an account.-excludeStageDirs :: [RelDir] -> AbsDir -> [RelDir]-excludeStageDirs stages dir-  | dirname (parent (parent (parent dir))) == [reldir|import|] = stages ++ common-  | otherwise = common-  where-    common = [[reldir|_manual_|], [reldir|__pycache__|]]  groupIncludesUpTo :: RelDir -> [RelFile] -> InputFileBundle groupIncludesUpTo stopAt = collect Map.empty
src/Hledger/Flow/Import/ImportHelpersTurtle.hs view
@@ -1,16 +1,13 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}  -- | Generate journal include files and their relative include directives. module Hledger.Flow.Import.ImportHelpersTurtle-  ( allYearIncludeFiles,-    extractImportDirs,-    extraIncludesForFile,-    groupIncludeFiles,-    groupAndWriteIncludeFiles,+  ( extraIncludesForFile,     includePreamble,     toIncludeFiles,     toIncludeLine,-    writeIncludesUpTo,+    writeIncludesFromInventory,     writeToplevelAllYearsInclude,     yearsIncludeMap,   )@@ -18,14 +15,15 @@  import Control.Concurrent.STM (TChan) import Control.Monad (unless)-import Data.Either (isRight) import qualified Data.List as List (isPrefixOf, nub, sort) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T+import qualified Data.Text.IO as T import Hledger.Flow.BaseDir (relativeToBase, relativeToBase', turtleBaseDir) import Hledger.Flow.Common (allYearsFileName, directivesFile, filterPaths, groupValuesBy, writeFiles, writeFiles')-import Hledger.Flow.Import.ImportHelpers (extractImportDirs, groupIncludesUpTo)+import Hledger.Flow.Import.ImportHelpers (groupIncludesUpTo)+import Hledger.Flow.Import.Inventory (manualIncludeFiles, managedIncludeFiles) import Hledger.Flow.Import.Types import Hledger.Flow.Logging (logVerbose) import Hledger.Flow.PathHelpers (AbsDir, AbsFile)@@ -36,50 +34,15 @@ import qualified System.FilePath as FilePath import System.FilePath ((</>)) -groupIncludeFiles :: [FilePath] -> (TurtleFileBundle, TurtleFileBundle)-groupIncludeFiles = allYearIncludeFiles . groupIncludeFilesPerYear . filter isJournalFile- isJournalFile :: FilePath -> Bool isJournalFile f = FilePath.takeExtension f == ".journal" -allYearIncludeFiles :: TurtleFileBundle -> (TurtleFileBundle, TurtleFileBundle)-allYearIncludeFiles m = (m, yearsIncludeMap $ Map.keys m)- yearsIncludeMap :: [FilePath] -> TurtleFileBundle yearsIncludeMap = groupValuesBy allYearsPath  allYearsPath :: FilePath -> FilePath allYearsPath journal = fst (FilePath.splitFileName journal) </> allYearsFileName -includeFileName :: FilePath -> FilePath-includeFileName journal = FilePath.takeFileName (FilePath.takeDirectory journal) ++ "-include.journal"--groupIncludeFilesPerYear :: [FilePath] -> TurtleFileBundle-groupIncludeFilesPerYear [] = Map.empty-groupIncludeFilesPerYear ps@(p : _)-  | maybe False (Path.prjSomeBase (isRight . extractImportDirs)) (Path.parseSomeFile p) =-      groupValuesBy initialIncludeFilePath ps-  | otherwise = groupValuesBy parentIncludeFilePath ps--initialIncludeFilePath :: FilePath -> FilePath-initialIncludeFilePath p = ancestorDir 3 p </> includeFileName p--parentIncludeFilePath :: FilePath -> FilePath-parentIncludeFilePath p = ancestorDir 2 p </> FilePath.takeFileName p---- Keep the original path components (including separators) when constructing--- include-map keys. Relative keys have historically been rooted at "./".-ancestorDir :: Int -> FilePath -> FilePath-ancestorDir levels file = prefix </> FilePath.joinPath parents-  where-    (drive, rest) = FilePath.splitDrive file-    parts = FilePath.splitPath rest-    parents = take (length parts - levels) parts-    prefix = case parents of-      first : _ | first == "./" || first == "../" -> drive-      _ | null drive -> "./"-      _ -> drive- toIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> TurtleFileBundle -> IO (Map.Map FilePath T.Text) toIncludeFiles opts ch m = do   preMap <- extraIncludes opts ch (Map.keys m) ["opening.journal"] ["pre-import.journal"] []@@ -108,29 +71,47 @@ includePreamble :: T.Text includePreamble = "### Generated by hledger-flow - DO NOT EDIT ###\n" -groupAndWriteIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> IO [FilePath]-groupAndWriteIncludeFiles opts ch = writeFileMap opts ch . groupIncludeFiles- writeFileMap :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> (TurtleFileBundle, TurtleFileBundle) -> IO [FilePath] writeFileMap opts ch (m, allYears) = do   _ <- writeFiles' $ (addPreamble . toIncludeFiles' Map.empty Map.empty) allYears   writeFiles . (toIncludeFiles opts ch) $ m -writeIncludesUpTo :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> AbsDir -> [AbsFile] -> IO [AbsFile]-writeIncludesUpTo opts ch stopAt journals = do+writeIncludesFromInventory :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> AbsDir -> [AbsFile] -> [AbsFile] -> IO [AbsFile]+writeIncludesFromInventory opts ch stopAt inventory journals = do   let base = baseDir opts+      importRoot = base Path.</> [Path.reldir|import|]       journalFiles = filter (isJournalFile . Path.toFilePath) journals   boundary <- Path.stripProperPrefix base stopAt   unless (all (Path.isProperPrefixOf stopAt) journalFiles) $     ioError (userError "Journal file outside the requested include directory")   inputs <- mapM (Path.stripProperPrefix base) journalFiles-  let groups = groupIncludesUpTo boundary inputs+  manual <- manualIncludeFiles importRoot (filter (Path.isProperPrefixOf stopAt) inventory)+  seeds <- mapM (Path.stripProperPrefix base) manual+  let groups = Map.unionsWith (++)+        [ groupIncludesUpTo boundary inputs,+          groupIncludesUpTo boundary seeds,+          Map.fromList [(seed, []) | seed <- seeds]+        ]       absolute file = Path.toFilePath (base Path.</> file)       includes = Map.mapKeys absolute (Map.map (map absolute) groups)       years = yearsIncludeMap (Map.keys includes)       allAtStop = Path.toFilePath stopAt </> allYearsFileName-  _ <- writeFileMap opts ch (includes, Map.insertWith (++) allAtStop [] years)+      indexes = Map.insertWith (++) allAtStop [] years+      current = Map.union includes indexes+  -- Empty obsolete generated indexes as well as removing their parent links:+  -- users can open an account or year ledger directly.+  let old = managedIncludeFiles importRoot (filter (Path.isProperPrefixOf stopAt) inventory)+  mapM_ (clearObsolete current) old+  _ <- writeFileMap opts ch (includes, indexes)   return [base Path.</> f | f <- Map.keys groups, Path.parent f == boundary]+  where+    clearObsolete current file = unless (Map.member (Path.toFilePath file) current) $ do+      contents <- T.readFile (Path.toFilePath file)+      if includePreamble `T.isPrefixOf` contents+        then do+          _ <- writeFiles' (Map.singleton (Path.toFilePath file) (includePreamble <> "\n"))+          return ()+        else return ()  writeToplevelAllYearsInclude :: (HasBaseDir o, HasVerbosity o) => o -> IO [FilePath] writeToplevelAllYearsInclude opts = do
+ src/Hledger/Flow/Import/Inventory.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++-- | Discover first, then classify paths relative to the known import root.+module Hledger.Flow.Import.Inventory+  ( findImportFiles,+    stageFiles,+    inImportScope,+    generatedOutput,+    expectedOutputs,+    conflictingOutputs,+    canonicalFile,+    manualIncludeFiles,+    managedIncludeFiles,+    moveToTrash,+  )+where++import Control.Exception (bracket_)+import Control.Monad (forM)+import Data.Char (isDigit)+import qualified Data.List as List+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import Hledger.Flow.PathHelpers (AbsDir, AbsFile, RelDir)+import Path+import qualified Path.IO as PathIO+import qualified System.Directory as Directory+import qualified System.FilePath as FilePath+import System.IO.Error (catchIOError, isAlreadyExistsError, isDoesNotExistError)++findImportFiles :: AbsDir -> IO [AbsFile]+findImportFiles root = List.sort <$> PathIO.walkDirAccum (Just exclude) collect root+  where+    exclude _ dirs _ = return $ PathIO.WalkExclude $+      filter (ignored . FilePath.dropTrailingPathSeparator . toFilePath . dirname) dirs+    collect _ _ files = return $ filter (not . hidden . toFilePath . filename) files+    ignored name = hidden name || name == "__pycache__"+    hidden ('.' : _) = True+    hidden _ = False++relativeParts :: AbsDir -> AbsFile -> [String]+relativeParts root file = maybe [] (FilePath.splitDirectories . toFilePath) (stripProperPrefix root file)++isYear :: String -> Bool+isYear year = length year == 4 && all isDigit year++stageFiles :: AbsDir -> RelDir -> [AbsFile] -> [AbsFile]+stageFiles root stage = filter matches+  where+    name = FilePath.dropTrailingPathSeparator (toFilePath stage)+    matches file = case relativeParts root file of+      [_, _, _, actualStage, year, _] -> actualStage == name && isYear year+      _ -> False++-- Call only on classified stage files, which have a numeric year parent.+inImportScope :: AbsDir -> Integer -> AbsFile -> Bool+inImportScope scope startYear file =+  isProperPrefixOf scope file && read year >= startYear+  where+    year = FilePath.dropTrailingPathSeparator (toFilePath (dirname (parent file)))++generatedOutput :: RelDir -> String -> AbsFile -> IO AbsFile+generatedOutput stage extension source = do+  name <- parseRelFile (FilePath.replaceExtension (toFilePath (filename source)) extension)+  return (parent (parent (parent source)) </> stage </> dirname (parent source) </> name)++expectedOutputs :: [AbsFile] -> IO (Map.Map AbsFile [AbsFile])+expectedOutputs sources = do+  pairs <- outputPairs sources+  canonical <- forM pairs $ \(output, source) -> do+    key <- canonicalFile output+    return (key, [source])+  return (Map.fromListWith (++) canonical)++canonicalFile :: AbsFile -> IO AbsFile+canonicalFile file = Directory.canonicalizePath (toFilePath file) >>= parseAbsFile++outputPairs :: [AbsFile] -> IO [(AbsFile, AbsFile)]+outputPairs sources = concat <$> mapM outputs sources+  where+    outputs source = do+      csv <- generatedOutput [reldir|2-preprocessed|] ".csv" source+      journal <- generatedOutput [reldir|3-journal|] ".journal" source+      return [(csv, source), (journal, source)]++-- Nonexistent outputs cannot be canonicalized for case or Unicode aliases.+-- Probe their names in a temporary directory on the destination filesystem.+conflictingOutputs :: [AbsFile] -> IO [(AbsFile, [AbsFile])]+conflictingOutputs sources = do+  pairs <- outputPairs sources+  grouped <- forM pairs $ \pair@(output, _) -> do+    directory <- Directory.canonicalizePath (toFilePath (parent output)) >>= parseAbsDir+    return (directory, [pair])+  fmap concat $ forM (Map.toAscList (Map.fromListWith (++) grouped)) $ \(directory, outputs) -> do+    existing <- nearestDirectory directory+    PathIO.withTempDir existing ".hledger-flow-destinations-" $ \tmp -> do+      names <- forM outputs $ \pair@(output, _) -> do+        name <- parseRelDir (toFilePath (filename output))+        let probe = tmp </> name+        PathIO.createDirIfMissing True probe+        key <- Directory.canonicalizePath (toFilePath probe)+        return (key, [pair])+      return [(output, source : map snd rest)+             | (output, source) : rest <- Map.elems (Map.fromListWith (++) names), not (null rest)]+  where+    nearestDirectory directory = do+      exists <- PathIO.doesDirExist directory+      if exists then return directory else nearestDirectory (parent directory)++-- Seed the include at the manual file's own level; its contents are added by+-- the existing pre/post renderer, keeping ordering and avoiding duplicates.+manualIncludeFiles :: AbsDir -> [AbsFile] -> IO [AbsFile]+manualIncludeFiles root files = Set.toAscList . Set.fromList <$> mapM includePath (filter supported files)+  where+    supported file = case reverse (relativeParts root file) of+      name : year : "_manual_" : ancestors ->+        length ancestors <= 3 && isYear year+          && name `elem` ["pre-import.journal", "post-import.journal"]+      _ -> False+    includePath file = do+      let year = FilePath.dropTrailingPathSeparator (toFilePath (dirname (parent file)))+      name <- parseRelFile (year ++ "-include.journal")+      return (parent (parent (parent file)) </> name)++managedIncludeFiles :: AbsDir -> [AbsFile] -> [AbsFile]+managedIncludeFiles root = filter supported+  where+    supported file = case reverse (relativeParts root file) of+      name : ancestors -> length ancestors <= 3+        && (name == "all-years.journal" || (isYear (take 4 name) && drop 4 name == "-include.journal"))+      _ -> False++moveToTrash :: AbsFile -> IO AbsFile+moveToTrash file = do+  let year = dirname (parent file)+      stage = dirname (parent (parent file))+      account = parent (parent (parent file))+      trash = account </> [reldir|.trash|]+      lock = trash </> [reldir|.move-lock|]+      destination = trash </> year </> stage+      acquire = Directory.createDirectory (toFilePath lock) `catchIOError` \err ->+        if isAlreadyExistsError err+          then ioError (userError ("Trash is in use: " ++ toFilePath lock+            ++ ". If no import is running, remove this empty lock directory and retry."))+          else ioError err+  PathIO.createDirIfMissing True trash+  -- Serialize destination selection and rename so two imports cannot replace+  -- each other's recovery files. An interrupted move leaves a recoverable lock.+  bracket_ acquire (PathIO.removeDir lock) $ do+    PathIO.createDirIfMissing True destination+    target <- available destination (0 :: Integer)+    PathIO.renameFile file target+    return target+  where+    available destination n = do+      name <- parseRelFile (toFilePath (filename file) ++ if n == 0 then "" else "." ++ show n)+      let target = destination </> name+      exists <- Directory.doesPathExist (toFilePath target)+      -- A dangling symlink also occupies the destination name.+      link <- PathIO.isSymlink target `catchIOError` \err ->+        if isDoesNotExistError err then return False else ioError err+      if exists || link then available destination (n + 1) else return target
src/Hledger/Flow/PathHelpers.hs view
@@ -6,7 +6,6 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.Text as T import Hledger.Flow.DocHelpers (docURL)-import Path ((</>)) import qualified Path import qualified Path.IO as Path import System.Directory (doesDirectoryExist)@@ -64,33 +63,3 @@  pathSize' :: Path.Path b Path.Dir -> Int -> Int pathSize' p count = if Path.parent p == p then count else pathSize' (Path.parent p) (count + 1)---- | Do a recursive search starting from the given directory.--- Return all files contained in each directory which matches the given predicate.-findFilesIn ::-  (MonadIO m) =>-  -- | Do we want the files in this directory?-  (AbsDir -> Bool) ->-  -- | Exclude these directory names-  [RelDir] ->-  -- | Top of the search tree-  AbsDir ->-  -- | Absolute paths to all files in the directories which match the predicate-  m [AbsFile]-findFilesIn includePred excludeDirs = findFilesInWith includePred (const excludeDirs)--findFilesInWith :: MonadIO m => (AbsDir -> Bool) -> (AbsDir -> [RelDir]) -> AbsDir -> m [AbsFile]-findFilesInWith includePred excludeDirs = Path.walkDirAccum (Just excludeHandler) accumulator-  where-    excludeHandler currentDir _ _ = return $ Path.WalkExclude (map (currentDir </>) (excludeDirs currentDir))-    accumulator currentDir _ files =-      if includePred currentDir-        then return $ excludeHiddenFiles files-        else return []--excludeHiddenFiles :: [AbsFile] -> [AbsFile]-excludeHiddenFiles = filter (not . isHiddenFile)-  where-    isHiddenFile f = case Path.toFilePath (Path.filename f) of-      '.':_ -> True-      _ -> False
src/Hledger/Flow/Reports.hs view
@@ -28,13 +28,13 @@ import Prelude hiding (putStrLn, readFile, writeFile)  data ReportParams = ReportParams-  { ledgerFile :: FilePath,+  { ledgerFiles :: [FilePath],     reportYears :: [Integer],     outputDir :: AbsDir   }   deriving (Show) -type ReportGenerator = RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> AbsDir -> Integer -> IO (Either AbsFile AbsFile)+type ReportGenerator = RuntimeOptions -> TChan FlowTypes.LogMessage -> [FilePath] -> AbsDir -> Integer -> IO (Either AbsFile AbsFile)  generateReports :: RuntimeOptions -> IO () generateReports opts = withConsoleLogging $ \ch -> do@@ -63,7 +63,7 @@   aggregateYears <- includeYears ch journalWithYears   let aggregateParams =         ReportParams-          { ledgerFile = hledgerJournal,+          { ledgerFiles = [hledgerJournal],             reportYears = aggregateYears,             outputDir = aggregateReportDir           }@@ -76,50 +76,52 @@   parAwareActions opts (aggregateOnlyReports ++ ownerWithAggregateReports ++ ownerOnlyReports)  reportActions :: RuntimeOptions -> TChan FlowTypes.LogMessage -> [ReportGenerator] -> ReportParams -> [IO (Either AbsFile AbsFile)]-reportActions opts ch reports (ReportParams journal years reportsDir) = do+reportActions opts ch reports (ReportParams journals years reportsDir) = do   y <- years-  map (\r -> r opts ch journal reportsDir y) reports+  map (\r -> r opts ch journals reportsDir y) reports  accountList :: ReportGenerator-accountList opts ch journal baseOutDir year = do+accountList opts ch journals baseOutDir year = do   let reportArgs = ["accounts"]-  generateReport opts ch journal year baseOutDir [relfile|accounts.txt|] reportArgs (not . T.null)+  generateReport opts ch journals year baseOutDir [relfile|accounts.txt|] reportArgs (not . T.null)  unknownTransactions :: ReportGenerator-unknownTransactions opts ch journal baseOutDir year = do+unknownTransactions opts ch journals baseOutDir year = do   let reportArgs = ["print", "unknown"]-  generateReport opts ch journal year baseOutDir [relfile|unknown-transactions.txt|] reportArgs (not . T.null)+  generateReport opts ch journals year baseOutDir [relfile|unknown-transactions.txt|] reportArgs (not . T.null)  incomeStatement :: [T.Text] -> ReportGenerator-incomeStatement sharedOptions opts ch journal baseOutDir year = do+incomeStatement sharedOptions opts ch journals baseOutDir year = do   let reportArgs = ["incomestatement"] ++ sharedOptions-  generateReport opts ch journal year baseOutDir [relfile|income-expenses.txt|] reportArgs (not . T.null)+  generateReport opts ch journals year baseOutDir [relfile|income-expenses.txt|] reportArgs (not . T.null)  incomeMonthlyStatement :: [T.Text] -> ReportGenerator-incomeMonthlyStatement sharedOptions opts ch journal baseOutDir year = do+incomeMonthlyStatement sharedOptions opts ch journals baseOutDir year = do   let reportArgs = ["incomestatement"] ++ sharedOptions ++ ["--monthly"]-  generateReport opts ch journal year baseOutDir [relfile|monthly/income-expenses.txt|] reportArgs (not . T.null)+  generateReport opts ch journals year baseOutDir [relfile|monthly/income-expenses.txt|] reportArgs (not . T.null)  balanceSheet :: [T.Text] -> ReportGenerator-balanceSheet sharedOptions opts ch journal baseOutDir year = do+balanceSheet sharedOptions opts ch journals baseOutDir year = do   let reportArgs = ["balancesheet"] ++ sharedOptions ++ ["--flat"]-  generateReport opts ch journal year baseOutDir [relfile|balance-sheet.txt|] reportArgs (not . T.null)+  generateReport opts ch journals year baseOutDir [relfile|balance-sheet.txt|] reportArgs (not . T.null)  transferBalance :: ReportGenerator-transferBalance opts ch journal baseOutDir year = do+transferBalance opts ch journals baseOutDir year = do   let reportArgs = ["balance"] ++ (if prettyReports opts then ["--pretty-tables"] else []) ++ ["--quarterly", "--flat", "--no-total", "transfer"]-  generateReport opts ch journal year baseOutDir [relfile|transfer-balance.txt|] reportArgs (\txt -> (length $ T.lines txt) > 4)+  generateReport opts ch journals year baseOutDir [relfile|transfer-balance.txt|] reportArgs (\txt -> (length $ T.lines txt) > 4) -generateReport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> Integer -> AbsDir -> RelFile -> [T.Text] -> (T.Text -> Bool) -> IO (Either AbsFile AbsFile)-generateReport opts ch journal year reportsDir fileName args successCheck = do+generateReport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> [FilePath] -> Integer -> AbsDir -> RelFile -> [T.Text] -> (T.Text -> Bool) -> IO (Either AbsFile AbsFile)+generateReport opts ch journals year reportsDir fileName args successCheck = do   yearDir <- parseRelDir (show year)   let outputFile = reportsDir </> yearDir </> fileName   PathIO.createDirIfMissing True (parent outputFile)-  let relativeJournal = relativeToBase opts journal+  let relativeJournals = map (relativeToBase opts) journals   let relativeOutputFile = relativeToBase opts (toFilePath outputFile)   let confArgs = hledgerConfArgs opts-  let reportArgs = confArgs ++ ["--file", T.pack journal, "--period", T.pack (show year)] ++ args-  let reportDisplayArgs = confArgs ++ ["--file", T.pack relativeJournal, "--period", T.pack (show year)] ++ args+  let fileArgs = concatMap (\file -> ["--file", T.pack file])+  let periodArgs = ["--period", T.pack (show year)]+  let reportArgs = confArgs ++ fileArgs journals ++ periodArgs ++ args+  let reportDisplayArgs = confArgs ++ fileArgs relativeJournals ++ periodArgs ++ args   let hledger = T.pack (toFilePath (FlowTypes.hlPath (hledgerInfo opts)))   let cmdLabel = "hledger " <> showCmdArgs reportDisplayArgs   ((exitCode, stdOut, _), _) <- timeAndExitOnErr opts ch cmdLabel dummyLogger channelErr (hledger, reportArgs, Nothing)@@ -144,4 +146,7 @@   let ownerJournal = baseDir opts </> [reldir|import|] </> owner </> [relfile|all-years.journal|]       reportsDir = baseDir opts </> [reldir|reports|] </> owner   years <- includeYears ch ownerJournal-  return $ ReportParams (toFilePath ownerJournal) years reportsDir+  let directives = directivesFile opts+  directivesExist <- PathIO.doesFileExist directives+  let journals = [toFilePath directives | directivesExist] ++ [toFilePath ownerJournal]+  return $ ReportParams journals years reportsDir
test/BaseDir/Integration.hs view
@@ -43,7 +43,7 @@ assertFindTestFileUsingRundir :: BaseDir -> RunDir -> IO () assertFindTestFileUsingRundir baseDir runDir = do   let absRunDir = baseDir </> runDir-  foundFiles <- findFilesIn (const True) [] absRunDir+  (_, foundFiles) <- listDirRecur absRunDir   case filter ((== [relfile|test-file.txt|]) . filename) foundFiles of     (found : _) -> do       fileContents <- T.readFile (toFilePath found)
test/CSVImport/ImportHelperTests.hs view
@@ -6,7 +6,7 @@  import qualified Data.Text as T import Hledger.Flow.DocHelpers (docURL)-import Hledger.Flow.Import.ImportHelpers (extractImportDirs, groupIncludesUpTo, includeFileName)+import Hledger.Flow.Import.ImportHelpers (extractImportDirs, groupIncludesUpTo) import Hledger.Flow.Import.Types (ImportDirs (..), InputFileBundle) import Path import Test.HUnit hiding (Path)@@ -44,106 +44,22 @@             <> "Have a look at the documentation for a detailed explanation:\n"             <> docURL "input-files") err -testToJournal :: Test-testToJournal =-  TestCase-    ( do-        let journal = toJournal [relfile|import/jane/bogartbank/investment/1-in/2020/2020-09-30.csv|]-        let expected = [relfile|import/jane/bogartbank/investment/3-journal/2020/2020-09-30.journal|]-        assertEqual "toJournal" expected journal-    )--testIncludeFileName :: Test-testIncludeFileName =-  TestCase-    ( do-        let includeFile = includeFileName [relfile|import/jane/bogartbank/investment/3-journals/2020/2020-09-30.journal|]-        assertEqual "includeFileName" [relfile|2020-include.journal|] includeFile-    )--testGroupIncludesUpToTinySet :: Test-testGroupIncludesUpToTinySet =-  TestCase-    ( do-        let expected =-              [ ([relfile|import/jane/bogartbank/savings/2017-include.journal|], [janeSavingsJournal2017]),-                ([relfile|import/jane/bogartbank/2017-include.journal|], [[relfile|import/jane/bogartbank/savings/2017-include.journal|]]),-                ([relfile|import/jane/2017-include.journal|], [[relfile|import/jane/bogartbank/2017-include.journal|]])-              ] ::-                InputFileBundle--        let grouped = groupIncludesUpTo [reldir|import/jane|] [janeSavingsJournal2017]-        assertEqual "groupIncludesUpTo: A single journal file grouping" expected grouped-    )--testGroupIncludesUpToSmallSet :: Test-testGroupIncludesUpToSmallSet =-  TestCase-    ( do-        let expected =-              [ ([relfile|import/jane/bogartbank/savings/2017-include.journal|], [janeSavingsJournal2017]),-                ([relfile|import/jane/bogartbank/savings/2018-include.journal|], janeSavingsJournals2018),-                ([relfile|import/jane/bogartbank/savings/2019-include.journal|], [janeSavingsJournal2019]),-                ([relfile|import/jane/bogartbank/2017-include.journal|], [[relfile|import/jane/bogartbank/savings/2017-include.journal|]]),-                ([relfile|import/jane/bogartbank/2018-include.journal|], [[relfile|import/jane/bogartbank/savings/2018-include.journal|]]),-                ([relfile|import/jane/bogartbank/2019-include.journal|], [[relfile|import/jane/bogartbank/savings/2019-include.journal|]]),-                ([relfile|import/jane/2017-include.journal|], [[relfile|import/jane/bogartbank/2017-include.journal|]]),-                ([relfile|import/jane/2018-include.journal|], [[relfile|import/jane/bogartbank/2018-include.journal|]]),-                ([relfile|import/jane/2019-include.journal|], [[relfile|import/jane/bogartbank/2019-include.journal|]])-              ] ::-                InputFileBundle--        let grouped = groupIncludesUpTo [reldir|import/jane|] janeSavingsJournals-        assertEqual "groupIncludesUpTo: A small set of journal files - same account over 3 years" expected grouped-    )- testGroupIncludesUpTo :: Test-testGroupIncludesUpTo =-  TestCase-    ( do-        let expected =-              [ ([relfile|import/john/bogartbank/savings/2017-include.journal|], johnSavingsJournals2017),-                ([relfile|import/john/bogartbank/savings/2018-include.journal|], johnSavingsJournals2018),-                ([relfile|import/john/bogartbank/checking/2018-include.journal|], johnCheckingJournals2018),-                ([relfile|import/john/bogartbank/checking/2019-include.journal|], johnCheckingJournals2019),-                ([relfile|import/john/otherbank/creditcard/2017-include.journal|], [johnCCJournal2017]),-                ([relfile|import/john/otherbank/creditcard/2018-include.journal|], [johnCCJournal2018]),-                ([relfile|import/john/otherbank/investments/2018-include.journal|], [johnInvestJournal2018]),-                ([relfile|import/john/otherbank/investments/2019-include.journal|], [johnInvestJournal2019]),-                ([relfile|import/jane/bogartbank/savings/2017-include.journal|], [janeSavingsJournal2017]),-                ([relfile|import/jane/bogartbank/savings/2018-include.journal|], janeSavingsJournals2018),-                ([relfile|import/jane/bogartbank/savings/2019-include.journal|], [janeSavingsJournal2019]),-                ([relfile|import/jane/otherbank/creditcard/2017-include.journal|], [janeCCJournal2017]),-                ([relfile|import/jane/otherbank/creditcard/2018-include.journal|], [janeCCJournal2018]),-                ([relfile|import/jane/otherbank/investments/2018-include.journal|], [janeInvestJournal2018]),-                ([relfile|import/jane/otherbank/investments/2019-include.journal|], [janeInvestJournal2019]),-                ([relfile|import/john/bogartbank/2017-include.journal|], [[relfile|import/john/bogartbank/savings/2017-include.journal|]]),-                ([relfile|import/john/bogartbank/2018-include.journal|], [[relfile|import/john/bogartbank/checking/2018-include.journal|], [relfile|import/john/bogartbank/savings/2018-include.journal|]]),-                ([relfile|import/john/bogartbank/2019-include.journal|], [[relfile|import/john/bogartbank/checking/2019-include.journal|]]),-                ([relfile|import/john/otherbank/2017-include.journal|], [[relfile|import/john/otherbank/creditcard/2017-include.journal|]]),-                ([relfile|import/john/otherbank/2018-include.journal|], [[relfile|import/john/otherbank/creditcard/2018-include.journal|], [relfile|import/john/otherbank/investments/2018-include.journal|]]),-                ([relfile|import/john/otherbank/2019-include.journal|], [[relfile|import/john/otherbank/investments/2019-include.journal|]]),-                ([relfile|import/jane/bogartbank/2017-include.journal|], [[relfile|import/jane/bogartbank/savings/2017-include.journal|]]),-                ([relfile|import/jane/bogartbank/2018-include.journal|], [[relfile|import/jane/bogartbank/savings/2018-include.journal|]]),-                ([relfile|import/jane/bogartbank/2019-include.journal|], [[relfile|import/jane/bogartbank/savings/2019-include.journal|]]),-                ([relfile|import/jane/otherbank/2017-include.journal|], [[relfile|import/jane/otherbank/creditcard/2017-include.journal|]]),-                ([relfile|import/jane/otherbank/2018-include.journal|], [[relfile|import/jane/otherbank/creditcard/2018-include.journal|], [relfile|import/jane/otherbank/investments/2018-include.journal|]]),-                ([relfile|import/jane/otherbank/2019-include.journal|], [[relfile|import/jane/otherbank/investments/2019-include.journal|]]),-                ([relfile|import/john/2017-include.journal|], [[relfile|import/john/bogartbank/2017-include.journal|], [relfile|import/john/otherbank/2017-include.journal|]]),-                ([relfile|import/john/2018-include.journal|], [[relfile|import/john/bogartbank/2018-include.journal|], [relfile|import/john/otherbank/2018-include.journal|]]),-                ([relfile|import/john/2019-include.journal|], [[relfile|import/john/bogartbank/2019-include.journal|], [relfile|import/john/otherbank/2019-include.journal|]]),-                ([relfile|import/jane/2017-include.journal|], [[relfile|import/jane/bogartbank/2017-include.journal|], [relfile|import/jane/otherbank/2017-include.journal|]]),-                ([relfile|import/jane/2018-include.journal|], [[relfile|import/jane/bogartbank/2018-include.journal|], [relfile|import/jane/otherbank/2018-include.journal|]]),-                ([relfile|import/jane/2019-include.journal|], [[relfile|import/jane/bogartbank/2019-include.journal|], [relfile|import/jane/otherbank/2019-include.journal|]]),-                ([relfile|import/2017-include.journal|], [[relfile|import/jane/2017-include.journal|], [relfile|import/john/2017-include.journal|]]),-                ([relfile|import/2018-include.journal|], [[relfile|import/jane/2018-include.journal|], [relfile|import/john/2018-include.journal|]]),-                ([relfile|import/2019-include.journal|], [[relfile|import/jane/2019-include.journal|], [relfile|import/john/2019-include.journal|]])-              ] ::-                InputFileBundle--        let grouped = groupIncludesUpTo [reldir|import|] journalFiles-        assertEqual "groupIncludesUpTo: A full set of journal files" expected grouped-    )+testGroupIncludesUpTo = TestCase $ do+  let first = [relfile|import/jane/bank/savings/3-journal/2019/first.journal|]+      second = [relfile|import/jane/bank/savings/3-journal/2020/second.journal|]+      other = [relfile|import/john/bank/checking/3-journal/2019/other.journal|]+      expected =+        [ ([relfile|import/jane/bank/savings/2019-include.journal|], [first]),+          ([relfile|import/jane/bank/savings/2020-include.journal|], [second]),+          ([relfile|import/jane/bank/2019-include.journal|], [[relfile|import/jane/bank/savings/2019-include.journal|]]),+          ([relfile|import/jane/bank/2020-include.journal|], [[relfile|import/jane/bank/savings/2020-include.journal|]]),+          ([relfile|import/jane/2019-include.journal|], [[relfile|import/jane/bank/2019-include.journal|]]),+          ([relfile|import/jane/2020-include.journal|], [[relfile|import/jane/bank/2020-include.journal|]])+        ] :: InputFileBundle+  assertEqual "group both years up to the owner, excluding siblings" expected+    (groupIncludesUpTo [reldir|import/jane|] [second, other, first])+  assertEqual "empty input has no includes" [] (groupIncludesUpTo [reldir|import|] [])  tests :: Test-tests = TestList [testExtractImportDirs, testToJournal, testIncludeFileName, testGroupIncludesUpToTinySet, testGroupIncludesUpToSmallSet, testGroupIncludesUpTo]+tests = TestList [testExtractImportDirs, testGroupIncludesUpTo]
test/CSVImport/ImportHelperTurtleTests.hs view
@@ -1,511 +1,17 @@-{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}  module CSVImport.ImportHelperTurtleTests where -import Control.Concurrent.STM-import Data.Either+import Control.Concurrent.STM (newTChanIO)+import Data.Either (lefts) import qualified Data.Map.Strict as Map import qualified Data.Text as T-import Hledger.Flow.Common-import Hledger.Flow.Import.ImportHelpersTurtle (allYearIncludeFiles, groupIncludeFiles, toIncludeFiles, toIncludeLine, yearsIncludeMap)-import Hledger.Flow.Import.Types (TurtleFileBundle)+import Hledger.Flow.Common (includeYears')+import Hledger.Flow.Import.ImportHelpersTurtle (includePreamble, toIncludeFiles, toIncludeLine, yearsIncludeMap)+import qualified Path+import System.FilePath ((</>)) import Test.HUnit-import TestHelpers (defaultOpts, testRoot)-import TestHelpersTurtle--groupedJaneBogart :: TurtleFileBundle-groupedJaneBogart =-  [ ( "./import/jane/bogartbank/checking/2018-include.journal",-      ["import/jane/bogartbank/checking/3-journal/2018/2018-12-30.journal"]-    ),-    ( "./import/jane/bogartbank/checking/2019-include.journal",-      ["import/jane/bogartbank/checking/3-journal/2019/2019-01-30.journal"]-    ),-    ( "./import/jane/bogartbank/savings/2017-include.journal",-      ["import/jane/bogartbank/savings/3-journal/2017/2017-12-30.journal"]-    ),-    ( "./import/jane/bogartbank/savings/2018-include.journal",-      ["import/jane/bogartbank/savings/3-journal/2018/2018-01-30.journal"]-    )-  ]--groupedJaneOther :: TurtleFileBundle-groupedJaneOther =-  [ ( "./import/jane/otherbank/creditcard/2017-include.journal",-      ["import/jane/otherbank/creditcard/3-journal/2017/2017-12-30.journal"]-    ),-    ( "./import/jane/otherbank/creditcard/2018-include.journal",-      ["import/jane/otherbank/creditcard/3-journal/2018/2018-01-30.journal"]-    ),-    ( "./import/jane/otherbank/investments/2018-include.journal",-      ["import/jane/otherbank/investments/3-journal/2018/2018-12-30.journal"]-    ),-    ( "./import/jane/otherbank/investments/2019-include.journal",-      ["import/jane/otherbank/investments/3-journal/2019/2019-01-30.journal"]-    )-  ]--groupedJohnBogart :: TurtleFileBundle-groupedJohnBogart =-  [ ( "./import/john/bogartbank/checking/2018-include.journal",-      [ "import/john/bogartbank/checking/3-journal/2018/2018-11-30.journal",-        "import/john/bogartbank/checking/3-journal/2018/2018-10-30.journal",-        "import/john/bogartbank/checking/3-journal/2018/2018-12-30.journal"-      ]-    ),-    ( "./import/john/bogartbank/checking/2019-include.journal",-      [ "import/john/bogartbank/checking/3-journal/2019/2019-01-30.journal",-        "import/john/bogartbank/checking/3-journal/2019/2019-02-30.journal"-      ]-    ),-    ( "./import/john/bogartbank/savings/2017-include.journal",-      [ "import/john/bogartbank/savings/3-journal/2017/2017-11-30.journal",-        "import/john/bogartbank/savings/3-journal/2017/2017-12-30.journal"-      ]-    ),-    ( "./import/john/bogartbank/savings/2018-include.journal",-      [ "import/john/bogartbank/savings/3-journal/2018/2018-02-30.journal",-        "import/john/bogartbank/savings/3-journal/2018/2018-01-30.journal"-      ]-    )-  ]--groupedJohnOther :: TurtleFileBundle-groupedJohnOther =-  [ ( "./import/john/otherbank/creditcard/2017-include.journal",-      ["import/john/otherbank/creditcard/3-journal/2017/2017-12-30.journal"]-    ),-    ( "./import/john/otherbank/creditcard/2018-include.journal",-      ["import/john/otherbank/creditcard/3-journal/2018/2018-01-30.journal"]-    ),-    ( "./import/john/otherbank/investments/2018-include.journal",-      ["import/john/otherbank/investments/3-journal/2018/2018-12-30.journal"]-    ),-    ( "./import/john/otherbank/investments/2019-include.journal",-      ["import/john/otherbank/investments/3-journal/2019/2019-01-30.journal"]-    )-  ]--groupedIncludeFiles :: TurtleFileBundle-groupedIncludeFiles =-  groupedJaneBogart-    <> groupedJaneOther-    <> groupedJohnBogart-    <> groupedJohnOther--testYearsIncludeMap :: Test-testYearsIncludeMap =-  TestCase-    ( do-        let maps = allYearIncludeFiles groupedJohnOther-        let yearGrouping =-              [ ( "./import/john/otherbank/creditcard/all-years.journal",-                  [ "./import/john/otherbank/creditcard/2017-include.journal",-                    "./import/john/otherbank/creditcard/2018-include.journal"-                  ]-                ),-                ( "./import/john/otherbank/investments/all-years.journal",-                  [ "./import/john/otherbank/investments/2018-include.journal",-                    "./import/john/otherbank/investments/2019-include.journal"-                  ]-                )-              ]-        let expected = (groupedJohnOther, yearGrouping)-        assertEqual "An augmented map with grouped years per level added" expected maps-    )--testYearsIncludeGrouping :: Test-testYearsIncludeGrouping =-  TestCase-    ( do-        let yearsMap = yearsIncludeMap (Map.keys groupedJohnOther)-        let expected =-              [ ( "./import/john/otherbank/creditcard/all-years.journal",-                  [ "./import/john/otherbank/creditcard/2017-include.journal",-                    "./import/john/otherbank/creditcard/2018-include.journal"-                  ]-                ),-                ( "./import/john/otherbank/investments/all-years.journal",-                  [ "./import/john/otherbank/investments/2018-include.journal",-                    "./import/john/otherbank/investments/2019-include.journal"-                  ]-                )-              ]-        assertEqual "A basic map with grouped years per level" expected yearsMap-    )--testGroupIncludeFilesTinySet :: Test-testGroupIncludeFilesTinySet =-  TestCase-    ( do-        let journals1 = ["import/jane/bogartbank/savings/3-journals/2017/2017-12-30.journal"]-        let expected1 = [("./import/jane/bogartbank/savings/2017-include.journal", journals1)] :: TurtleFileBundle-        let expectedAllYears1 = [("./import/jane/bogartbank/savings/all-years.journal", ["./import/jane/bogartbank/savings/2017-include.journal"])]-        let (group1, allYears1) = groupIncludeFiles journals1-        assertEqual "groupIncludeFiles small allYears 1" expectedAllYears1 allYears1-        assertEqual "groupIncludeFiles small set 1" expected1 group1--        journals2 <- case Map.keys expected1 of-          (k : _) -> return [k]-          [] -> assertFailure "Expected non-empty include map for journals2"-        let expected2 = [("./import/jane/bogartbank/2017-include.journal", journals2)] :: TurtleFileBundle-        let expectedAllYears2 = [("./import/jane/bogartbank/all-years.journal", ["./import/jane/bogartbank/2017-include.journal"])]-        let (group2, allYears2) = groupIncludeFiles journals2-        assertEqual "groupIncludeFiles small allYears 2" expectedAllYears2 allYears2-        assertEqual "groupIncludeFiles small set 2" expected2 group2--        journals3 <- case Map.keys expected2 of-          (k : _) -> return [k]-          [] -> assertFailure "Expected non-empty include map for journals3"-        let expected3 = [("./import/jane/2017-include.journal", journals3)] :: TurtleFileBundle-        let expectedAllYears3 = [("./import/jane/all-years.journal", ["./import/jane/2017-include.journal"])]-        let (group3, allYears3) = groupIncludeFiles journals3-        assertEqual "groupIncludeFiles small allYears 3" expectedAllYears3 allYears3-        assertEqual "groupIncludeFiles small set 3" expected3 group3-    )--testGroupIncludeFilesSmallSet :: Test-testGroupIncludeFilesSmallSet =-  TestCase-    ( do-        let (group1, allYears1) = groupIncludeFiles $ toJournals inputJaneBogart-        let expectedAllYears1 =-              [ ( "./import/jane/bogartbank/checking/all-years.journal",-                  [ "./import/jane/bogartbank/checking/2018-include.journal",-                    "./import/jane/bogartbank/checking/2019-include.journal"-                  ]-                ),-                ( "./import/jane/bogartbank/savings/all-years.journal",-                  [ "./import/jane/bogartbank/savings/2017-include.journal",-                    "./import/jane/bogartbank/savings/2018-include.journal"-                  ]-                )-              ]--        assertEqual "groupIncludeFiles Jane AllYears 1" expectedAllYears1 allYears1-        assertEqual "groupIncludeFiles Jane 1" groupedJaneBogart group1--        let (group2, allYears2) = groupIncludeFiles (Map.keys group1)-        let expectedAllYears2 =-              [ ( "./import/jane/bogartbank/all-years.journal",-                  [ "./import/jane/bogartbank/2017-include.journal",-                    "./import/jane/bogartbank/2018-include.journal",-                    "./import/jane/bogartbank/2019-include.journal"-                  ]-                )-              ]-        assertEqual "groupIncludeFiles Jane AllYears 2" expectedAllYears2 allYears2-        let expectedGroup2 =-              [ ( "./import/jane/bogartbank/2017-include.journal",-                  ["./import/jane/bogartbank/savings/2017-include.journal"]-                ),-                ( "./import/jane/bogartbank/2018-include.journal",-                  [ "./import/jane/bogartbank/checking/2018-include.journal",-                    "./import/jane/bogartbank/savings/2018-include.journal"-                  ]-                ),-                ( "./import/jane/bogartbank/2019-include.journal",-                  ["./import/jane/bogartbank/checking/2019-include.journal"]-                )-              ]-        assertEqual "groupIncludeFiles Jane 2" expectedGroup2 group2--        let (group3, allYears3) = groupIncludeFiles (Map.keys group2)-        let expectedAllYears3 =-              [ ( "./import/jane/all-years.journal",-                  [ "./import/jane/2017-include.journal",-                    "./import/jane/2018-include.journal",-                    "./import/jane/2019-include.journal"-                  ]-                )-              ]-        assertEqual "groupIncludeFiles Jane AllYears 3" expectedAllYears3 allYears3-        let expectedGroup3 =-              [ ( "./import/jane/2017-include.journal",-                  ["./import/jane/bogartbank/2017-include.journal"]-                ),-                ( "./import/jane/2018-include.journal",-                  ["./import/jane/bogartbank/2018-include.journal"]-                ),-                ( "./import/jane/2019-include.journal",-                  ["./import/jane/bogartbank/2019-include.journal"]-                )-              ]-        assertEqual "groupIncludeFiles Jane 3" expectedGroup3 group3--        let (group4, allYears4) = groupIncludeFiles (Map.keys group3)-        let expectedAllYears4 =-              [ ( "./import/all-years.journal",-                  [ "./import/2017-include.journal",-                    "./import/2018-include.journal",-                    "./import/2019-include.journal"-                  ]-                )-              ]-        assertEqual "groupIncludeFiles Jane AllYears 4" expectedAllYears4 allYears4-        let expectedGroup4 =-              [ ( "./import/2017-include.journal",-                  ["./import/jane/2017-include.journal"]-                ),-                ( "./import/2018-include.journal",-                  ["./import/jane/2018-include.journal"]-                ),-                ( "./import/2019-include.journal",-                  ["./import/jane/2019-include.journal"]-                )-              ]-        assertEqual "groupIncludeFiles Jane 4" expectedGroup4 group4--        let (group5, allYears5) = groupIncludeFiles (Map.keys group4)-        let expectedAllYears5 = [("./all-years.journal", ["./2017-include.journal", "./2018-include.journal", "./2019-include.journal"])]-        assertEqual "groupIncludeFiles Jane AllYears 5" expectedAllYears5 allYears5-        let expectedGroup5 =-              [ ( "./2017-include.journal",-                  ["./import/2017-include.journal"]-                ),-                ( "./2018-include.journal",-                  ["./import/2018-include.journal"]-                ),-                ( "./2019-include.journal",-                  ["./import/2019-include.journal"]-                )-              ]-        assertEqual "groupIncludeFiles Jane 5" expectedGroup5 group5-    )--testGroupIncludeFiles :: Test-testGroupIncludeFiles =-  TestCase-    ( do-        let (group1, allYears1) = groupIncludeFiles journalFiles-        let expectedAllYears1 =-              [ ( "./import/jane/bogartbank/checking/all-years.journal",-                  [ "./import/jane/bogartbank/checking/2018-include.journal",-                    "./import/jane/bogartbank/checking/2019-include.journal"-                  ]-                ),-                ( "./import/jane/bogartbank/savings/all-years.journal",-                  [ "./import/jane/bogartbank/savings/2017-include.journal",-                    "./import/jane/bogartbank/savings/2018-include.journal"-                  ]-                ),-                ( "./import/jane/otherbank/creditcard/all-years.journal",-                  [ "./import/jane/otherbank/creditcard/2017-include.journal",-                    "./import/jane/otherbank/creditcard/2018-include.journal"-                  ]-                ),-                ( "./import/jane/otherbank/investments/all-years.journal",-                  [ "./import/jane/otherbank/investments/2018-include.journal",-                    "./import/jane/otherbank/investments/2019-include.journal"-                  ]-                ),-                ( "./import/john/bogartbank/checking/all-years.journal",-                  [ "./import/john/bogartbank/checking/2018-include.journal",-                    "./import/john/bogartbank/checking/2019-include.journal"-                  ]-                ),-                ( "./import/john/bogartbank/savings/all-years.journal",-                  [ "./import/john/bogartbank/savings/2017-include.journal",-                    "./import/john/bogartbank/savings/2018-include.journal"-                  ]-                ),-                ( "./import/john/otherbank/creditcard/all-years.journal",-                  [ "./import/john/otherbank/creditcard/2017-include.journal",-                    "./import/john/otherbank/creditcard/2018-include.journal"-                  ]-                ),-                ( "./import/john/otherbank/investments/all-years.journal",-                  [ "./import/john/otherbank/investments/2018-include.journal",-                    "./import/john/otherbank/investments/2019-include.journal"-                  ]-                )-              ]-        assertEqual "groupIncludeFiles Jane AllYears 1" expectedAllYears1 allYears1-        assertEqual "groupIncludeFiles 1" groupedIncludeFiles group1--        let (group2, allYears2) = groupIncludeFiles (Map.keys group1)-        let expectedAllYears2 =-              [ ( "./import/jane/bogartbank/all-years.journal",-                  [ "./import/jane/bogartbank/2017-include.journal",-                    "./import/jane/bogartbank/2018-include.journal",-                    "./import/jane/bogartbank/2019-include.journal"-                  ]-                ),-                ( "./import/jane/otherbank/all-years.journal",-                  [ "./import/jane/otherbank/2017-include.journal",-                    "./import/jane/otherbank/2018-include.journal",-                    "./import/jane/otherbank/2019-include.journal"-                  ]-                ),-                ( "./import/john/bogartbank/all-years.journal",-                  [ "./import/john/bogartbank/2017-include.journal",-                    "./import/john/bogartbank/2018-include.journal",-                    "./import/john/bogartbank/2019-include.journal"-                  ]-                ),-                ( "./import/john/otherbank/all-years.journal",-                  [ "./import/john/otherbank/2017-include.journal",-                    "./import/john/otherbank/2018-include.journal",-                    "./import/john/otherbank/2019-include.journal"-                  ]-                )-              ]--        assertEqual "groupIncludeFiles Jane AllYears 2" expectedAllYears2 allYears2-        let expectedGroup2 =-              [ ( "./import/jane/bogartbank/2017-include.journal",-                  ["./import/jane/bogartbank/savings/2017-include.journal"]-                ),-                ( "./import/jane/bogartbank/2018-include.journal",-                  [ "./import/jane/bogartbank/checking/2018-include.journal",-                    "./import/jane/bogartbank/savings/2018-include.journal"-                  ]-                ),-                ( "./import/jane/bogartbank/2019-include.journal",-                  ["./import/jane/bogartbank/checking/2019-include.journal"]-                ),-                ( "./import/jane/otherbank/2017-include.journal",-                  ["./import/jane/otherbank/creditcard/2017-include.journal"]-                ),-                ( "./import/jane/otherbank/2018-include.journal",-                  [ "./import/jane/otherbank/creditcard/2018-include.journal",-                    "./import/jane/otherbank/investments/2018-include.journal"-                  ]-                ),-                ( "./import/jane/otherbank/2019-include.journal",-                  ["./import/jane/otherbank/investments/2019-include.journal"]-                ),-                ( "./import/john/bogartbank/2017-include.journal",-                  ["./import/john/bogartbank/savings/2017-include.journal"]-                ),-                ( "./import/john/bogartbank/2018-include.journal",-                  [ "./import/john/bogartbank/checking/2018-include.journal",-                    "./import/john/bogartbank/savings/2018-include.journal"-                  ]-                ),-                ( "./import/john/bogartbank/2019-include.journal",-                  ["./import/john/bogartbank/checking/2019-include.journal"]-                ),-                ( "./import/john/otherbank/2017-include.journal",-                  ["./import/john/otherbank/creditcard/2017-include.journal"]-                ),-                ( "./import/john/otherbank/2018-include.journal",-                  [ "./import/john/otherbank/creditcard/2018-include.journal",-                    "./import/john/otherbank/investments/2018-include.journal"-                  ]-                ),-                ( "./import/john/otherbank/2019-include.journal",-                  ["./import/john/otherbank/investments/2019-include.journal"]-                )-              ]-        assertEqual "groupIncludeFiles 2 - diff 1" [] (expectedGroup2 Map.\\ group2)-        assertEqual "groupIncludeFiles 2 - diff 2" [] (group2 Map.\\ expectedGroup2)-        assertEqual "groupIncludeFiles 2" expectedGroup2 group2--        let (group3, allYears3) = groupIncludeFiles (Map.keys group2)-        let expectedAllYears3 =-              [ ( "./import/jane/all-years.journal",-                  [ "./import/jane/2017-include.journal",-                    "./import/jane/2018-include.journal",-                    "./import/jane/2019-include.journal"-                  ]-                ),-                ( "./import/john/all-years.journal",-                  [ "./import/john/2017-include.journal",-                    "./import/john/2018-include.journal",-                    "./import/john/2019-include.journal"-                  ]-                )-              ]--        assertEqual "groupIncludeFiles Jane AllYears 3" expectedAllYears3 allYears3-        let expectedGroup3 =-              [ ( "./import/jane/2017-include.journal",-                  [ "./import/jane/bogartbank/2017-include.journal",-                    "./import/jane/otherbank/2017-include.journal"-                  ]-                ),-                ( "./import/jane/2018-include.journal",-                  [ "./import/jane/bogartbank/2018-include.journal",-                    "./import/jane/otherbank/2018-include.journal"-                  ]-                ),-                ( "./import/jane/2019-include.journal",-                  [ "./import/jane/bogartbank/2019-include.journal",-                    "./import/jane/otherbank/2019-include.journal"-                  ]-                ),-                ( "./import/john/2017-include.journal",-                  [ "./import/john/bogartbank/2017-include.journal",-                    "./import/john/otherbank/2017-include.journal"-                  ]-                ),-                ( "./import/john/2018-include.journal",-                  [ "./import/john/bogartbank/2018-include.journal",-                    "./import/john/otherbank/2018-include.journal"-                  ]-                ),-                ( "./import/john/2019-include.journal",-                  [ "./import/john/bogartbank/2019-include.journal",-                    "./import/john/otherbank/2019-include.journal"-                  ]-                )-              ]-        assertEqual "groupIncludeFiles 3 - diff 1" [] (expectedGroup3 Map.\\ group3)-        assertEqual "groupIncludeFiles 3 - diff 2" [] (group3 Map.\\ expectedGroup3)-        assertEqual "groupIncludeFiles 3" expectedGroup3 group3--        let (group4, allYears4) = groupIncludeFiles (Map.keys group3)-        let expectedAllYears4 =-              [ ( "./import/all-years.journal",-                  [ "./import/2017-include.journal",-                    "./import/2018-include.journal",-                    "./import/2019-include.journal"-                  ]-                )-              ]-        assertEqual "groupIncludeFiles Jane AllYears 4" expectedAllYears4 allYears4-        let expectedGroup4 =-              [ ( "./import/2017-include.journal",-                  [ "./import/jane/2017-include.journal",-                    "./import/john/2017-include.journal"-                  ]-                ),-                ( "./import/2018-include.journal",-                  [ "./import/jane/2018-include.journal",-                    "./import/john/2018-include.journal"-                  ]-                ),-                ( "./import/2019-include.journal",-                  [ "./import/jane/2019-include.journal",-                    "./import/john/2019-include.journal"-                  ]-                )-              ]-        assertEqual "groupIncludeFiles 4 - diff 1" [] (expectedGroup4 Map.\\ group4)-        assertEqual "groupIncludeFiles 4 - diff 2" [] (group4 Map.\\ expectedGroup4)-        assertEqual "groupIncludeFiles 4" expectedGroup4 group4--        let (group5, allYears5) = groupIncludeFiles (Map.keys group4)-        let expectedAllYears5 = [("./all-years.journal", ["./2017-include.journal", "./2018-include.journal", "./2019-include.journal"])]-        assertEqual "groupIncludeFiles Jane AllYears 5" expectedAllYears5 allYears5-        let expectedGroup5 =-              [ ( "./2017-include.journal",-                  ["./import/2017-include.journal"]-                ),-                ( "./2018-include.journal",-                  ["./import/2018-include.journal"]-                ),-                ( "./2019-include.journal",-                  ["./import/2019-include.journal"]-                )-              ]-        assertEqual "groupIncludeFiles 5 - diff 1" [] (expectedGroup5 Map.\\ group5)-        assertEqual "groupIncludeFiles 5 - diff 2" [] (group5 Map.\\ expectedGroup5)-        assertEqual "groupIncludeFiles 5" expectedGroup5 group5-    )+import TestHelpers (defaultOpts, withTestDir)  testIncludeYears :: Test testIncludeYears =@@ -556,61 +62,21 @@         assertEqual "Include line - absolute base dir without a trailing slash" expected absoluteNoTrailingSlash     ) -testToIncludeFiles :: Test-testToIncludeFiles =-  TestCase-    ( do-        let expected =-              [ ( "./import/john/bogartbank/checking/2018-include.journal",-                  "### Generated by hledger-flow - DO NOT EDIT ###\n\n"-                    <> "include 3-journal/2018/2018-10-30.journal\n"-                    <> "include 3-journal/2018/2018-11-30.journal\n"-                    <> "include 3-journal/2018/2018-12-30.journal\n"-                ),-                ( "./import/john/bogartbank/checking/2019-include.journal",-                  "### Generated by hledger-flow - DO NOT EDIT ###\n\n"-                    <> "include 3-journal/2019/2019-01-30.journal\n"-                    <> "include 3-journal/2019/2019-02-30.journal\n"-                ),-                ( "./import/john/bogartbank/savings/2017-include.journal",-                  "### Generated by hledger-flow - DO NOT EDIT ###\n\n"-                    <> "include 3-journal/2017/2017-11-30.journal\n"-                    <> "include 3-journal/2017/2017-12-30.journal\n"-                ),-                ( "./import/john/bogartbank/savings/2018-include.journal",-                  "### Generated by hledger-flow - DO NOT EDIT ###\n\n"-                    <> "include 3-journal/2018/2018-01-30.journal\n"-                    <> "include 3-journal/2018/2018-02-30.journal\n"-                )-              ]--        ch <- newTChanIO-        txt <- toIncludeFiles (defaultOpts testRoot) ch groupedJohnBogart-        assertEqual "Convert a grouped map of paths, to a map with text contents for each file" expected txt-    )--testGroupIncludeFilesFiltersNonJournal :: Test-testGroupIncludeFilesFiltersNonJournal =-  TestCase-    ( do-        let journal = "import/john/mybank/checking/3-journal/2019/2019-01-01.journal"-        let nonJournal = "import/john/mybank/checking/3-journal/2019/2019-01-01.csv"-        let (grouped, _) = groupIncludeFiles [journal, nonJournal]-        assertEqual "Only journal files should be grouped" 1 (Map.size grouped)-        let files = concat (Map.elems grouped)-        assertEqual "Non-journal files should be ignored" [journal] files-    )+testIncludeRendering :: Test+testIncludeRendering = TestCase $ withTestDir $ \base -> do+  let account = Path.toFilePath base </> "import/john/bank/checking"+      year2019 = account </> "2019-include.journal"+      year2020 = account </> "2020-include.journal"+      first = account </> "3-journal/2019/first.journal"+      lastJournal = account </> "3-journal/2019/last.journal"+  assertEqual "years share their account index"+    (Map.singleton (account </> "all-years.journal") [year2019, year2020])+    (yearsIncludeMap [year2019, year2020])+  ch <- newTChanIO+  rendered <- toIncludeFiles (defaultOpts base) ch+    (Map.singleton year2019 [lastJournal, first, lastJournal])+  assertEqual "sort and deduplicate relative include lines"+    (Map.singleton year2019 (includePreamble <> "\ninclude 3-journal/2019/first.journal\ninclude 3-journal/2019/last.journal\n")) rendered  tests :: Test-tests =-  TestList-    [ testYearsIncludeMap,-      testYearsIncludeGrouping,-      testGroupIncludeFilesTinySet,-      testGroupIncludeFilesSmallSet,-      testGroupIncludeFiles,-      testIncludeYears,-      testToIncludeLine,-      testToIncludeFiles,-      testGroupIncludeFilesFiltersNonJournal-    ]+tests = TestList [testIncludeYears, testToIncludeLine, testIncludeRendering]
test/CSVImport/Integration.hs view
@@ -4,10 +4,12 @@ module CSVImport.Integration (tests) where  import Control.Concurrent.STM-import qualified Data.List as List (sort) import qualified Data.Map.Strict as Map import qualified Data.Text.IO as T-import Hledger.Flow.Import.ImportHelpersTurtle (extraIncludesForFile, groupAndWriteIncludeFiles, includePreamble, toIncludeFiles, writeIncludesUpTo, writeToplevelAllYearsInclude)+import Hledger.Flow.Import.ImportHelpersTurtle (extraIncludesForFile, includePreamble, toIncludeFiles, writeIncludesFromInventory, writeToplevelAllYearsInclude)+import Hledger.Flow.Import.Inventory (findImportFiles)+import Hledger.Flow.RuntimeOptions (RuntimeOptions)+import Hledger.Flow.Types (LogMessage) import Hledger.Flow.PathHelpers import qualified Path import qualified Path.IO as PathIO@@ -16,21 +18,23 @@ import System.FilePath ((</>)) import qualified System.FilePath as FilePath import Test.HUnit-import TestHelpers (defaultOpts, withTestDir)-import TestHelpersTurtle (extraFiles, hiddenFiles, journalFiles, touchAll)+import TestHelpers (defaultOpts, withTestDir, touchAll) import Prelude hiding (readFile, writeFile) +-- Refresh the inventory exactly as the CLI does before writing includes.+writeIncludes :: RuntimeOptions -> TChan LogMessage -> AbsDir -> [AbsFile] -> IO [AbsFile]+writeIncludes opts ch stopAt journals = do+  inventory <- findImportFiles stopAt+  writeIncludesFromInventory opts ch stopAt inventory journals+ testExtraIncludesForFile :: Test testExtraIncludesForFile =   TestCase $ withTestDir $ \tmpdirAbsPath -> do     let tmpdir = Path.toFilePath tmpdirAbsPath -    let importedJournals = map (tmpdir </>) journalFiles :: [FilePath]     let accountDir = "import/john/bogartbank/savings"     let opening = tmpdir </> accountDir </> "2017-opening.journal"     let closing = tmpdir </> accountDir </> "2017-closing.journal"-    let hidden = map (tmpdir </>) hiddenFiles :: [FilePath]-    touchAll $ importedJournals ++ hidden      let accountInclude = tmpdir </> accountDir </> "2017-include.journal"     let expectedEmpty = [(accountInclude, [])]@@ -56,14 +60,13 @@   TestCase $ withTestDir $ \tmpdirAbsPath -> do     let tmpdir = Path.toFilePath tmpdirAbsPath -    let importedJournals = map (tmpdir </>) journalFiles :: [FilePath]-    touchAll $ importedJournals      let priceFile = "prices" </> "2020" </> "prices.journal"      let includeFile = tmpdir </> "import" </> "2020-include.journal"     let expectedEmpty = [(includeFile, [])] +    Path.parseAbsDir (tmpdir </> "import") >>= PathIO.createDir     ch <- newTChanIO      price1 <- extraIncludesForFile (defaultOpts tmpdirAbsPath) ch includeFile [] [] ["prices.journal"]@@ -156,112 +159,6 @@     let expectedMap = Map.singleton includeFile expectedText     assertEqual "The price file should be included together with any pre/post files" expectedMap fileMap -testWriteIncludeFiles :: Test-testWriteIncludeFiles =-  TestCase $ withTestDir $ \tmpdirAbsPath -> do-    let tmpdir = Path.toFilePath tmpdirAbsPath--    let importedJournals = map (tmpdir </>) journalFiles :: [FilePath]-    let extras = map (tmpdir </>) extraFiles :: [FilePath]-    let hidden = map (tmpdir </>) hiddenFiles :: [FilePath]-    touchAll $ importedJournals ++ extras ++ hidden--    let jane1 = tmpdir </> "import/jane/bogartbank/checking/2018-include.journal"-    let jane2 = tmpdir </> "import/jane/bogartbank/checking/2019-include.journal"-    let jane3 = tmpdir </> "import/jane/bogartbank/savings/2017-include.journal"-    let jane4 = tmpdir </> "import/jane/bogartbank/savings/2018-include.journal"-    let jane5 = tmpdir </> "import/jane/otherbank/creditcard/2017-include.journal"-    let jane6 = tmpdir </> "import/jane/otherbank/creditcard/2018-include.journal"-    let jane7 = tmpdir </> "import/jane/otherbank/investments/2018-include.journal"-    let jane8 = tmpdir </> "import/jane/otherbank/investments/2019-include.journal"--    let john1 = tmpdir </> "import/john/bogartbank/checking/2018-include.journal"-    let john2 = tmpdir </> "import/john/bogartbank/checking/2019-include.journal"-    let john3 = tmpdir </> "import/john/bogartbank/savings/2017-include.journal"-    let john4 = tmpdir </> "import/john/bogartbank/savings/2018-include.journal"-    let john5 = tmpdir </> "import/john/otherbank/creditcard/2017-include.journal"-    let john6 = tmpdir </> "import/john/otherbank/creditcard/2018-include.journal"-    let john7 = tmpdir </> "import/john/otherbank/investments/2018-include.journal"-    let john8 = tmpdir </> "import/john/otherbank/investments/2019-include.journal"-    let expectedIncludes =-          [ jane1,-            jane2,-            jane3,-            jane4,-            jane5,-            jane6,-            jane7,-            jane8,-            john1,-            john2,-            john3,-            john4,-            john5,-            john6,-            john7,-            john8-          ]--    ch <- newTChanIO-    reportedAsWritten <- groupAndWriteIncludeFiles (defaultOpts tmpdirAbsPath) ch importedJournals-    assertEqual "groupAndWriteIncludeFiles should return which files it wrote" expectedIncludes reportedAsWritten--    let allYears =-          [ tmpdir </> "import/jane/bogartbank/checking/all-years.journal",-            tmpdir </> "import/jane/bogartbank/savings/all-years.journal",-            tmpdir </> "import/jane/otherbank/creditcard/all-years.journal",-            tmpdir </> "import/jane/otherbank/investments/all-years.journal",-            tmpdir </> "import/john/bogartbank/checking/all-years.journal",-            tmpdir </> "import/john/bogartbank/savings/all-years.journal",-            tmpdir </> "import/john/otherbank/creditcard/all-years.journal",-            tmpdir </> "import/john/otherbank/investments/all-years.journal"-          ]-    let expectedOnDisk = List.sort $ reportedAsWritten ++ extras ++ importedJournals ++ allYears-    (_, allFiles) <- PathIO.listDirRecur tmpdirAbsPath-    let allFilesOnDisk = map Path.toFilePath (excludeHiddenFiles allFiles)-    assertEqual "The actual files on disk should match what groupAndWriteIncludeFiles reported" (List.sort $ map FilePath.normalise expectedOnDisk) (List.sort $ map FilePath.normalise allFilesOnDisk)--    let expectedJohn1Contents =-          includePreamble-            <> "\n"-            <> "include 3-journal/2018/2018-10-30.journal\n"-            <> "include 3-journal/2018/2018-11-30.journal\n"-            <> "include 3-journal/2018/2018-12-30.journal\n"-    actualJohn1Contents <- T.readFile john1-    assertEqual "John1: The include file contents should be the journal files" expectedJohn1Contents actualJohn1Contents--    let expectedJohn2Contents =-          includePreamble-            <> "\n"-            <> "include 3-journal/2019/2019-01-30.journal\n"-            <> "include 3-journal/2019/2019-02-30.journal\n"-    actualJohn2Contents <- T.readFile john2-    assertEqual "John2: The include file contents should be the journal files" expectedJohn2Contents actualJohn2Contents--    let expectedJohn3Contents =-          includePreamble-            <> "\n"-            <> "include 2017-opening.journal\n"-            <> "include 3-journal/2017/2017-11-30.journal\n"-            <> "include 3-journal/2017/2017-12-30.journal\n"-    actualJohn3Contents <- T.readFile john3-    assertEqual "John3: The include file contents should be the journal files" expectedJohn3Contents actualJohn3Contents--    let expectedJohn4Contents =-          includePreamble-            <> "\n"-            <> "include 3-journal/2018/2018-01-30.journal\n"-            <> "include 3-journal/2018/2018-02-30.journal\n"-    actualJohn4Contents <- T.readFile john4-    assertEqual "John4: The include file contents should be the journal files" expectedJohn4Contents actualJohn4Contents--    let expectedJane7Contents =-          includePreamble-            <> "\n"-            <> "include 3-journal/2018/2018-12-30.journal\n"-    actualJane7Contents <- T.readFile jane7-    assertEqual "Jane7: The include file contents should be the journal files" expectedJane7Contents actualJane7Contents- testWriteToplevelAllYearsInclude :: Test testWriteToplevelAllYearsInclude =   TestCase $ withTestDir $ \tmpdirAbsPath -> do@@ -289,8 +186,8 @@     actualWithDirectives <- T.readFile expectedFile     assertEqual "Top-level include should reference directives when present" expectedWithDirectives actualWithDirectives -testWriteIncludesUpTo :: Test-testWriteIncludesUpTo =+testWriteIncludes :: Test+testWriteIncludes =   TestCase $ withTestDir $ \tmpdirAbsPath -> do     let tmpdir = Path.toFilePath tmpdirAbsPath @@ -302,12 +199,12 @@     input <- Path.parseAbsFile journal     expectedFinal <- Path.parseAbsFile (tmpdir </> "import/2019-include.journal")     narrower <- Path.parseAbsDir (tmpdir </> "import" </> "other")-    rejected <- tryIOError (writeIncludesUpTo (defaultOpts tmpdirAbsPath) ch narrower [input])+    rejected <- tryIOError (writeIncludesFromInventory (defaultOpts tmpdirAbsPath) ch narrower [] [input])     assertBool "Reject a journal outside the boundary before writing" (isLeft rejected)     PathIO.doesFileExist expectedFinal >>= assertBool "No ancestor include written on rejection" . not -    written <- writeIncludesUpTo (defaultOpts tmpdirAbsPath) ch stopAt [input]-    assertEqual "writeIncludesUpTo should stop at the requested directory" [expectedFinal] written+    written <- writeIncludes (defaultOpts tmpdirAbsPath) ch stopAt [input]+    assertEqual "writeIncludes should stop at the requested directory" [expectedFinal] written      finalContents <- T.readFile (Path.toFilePath expectedFinal)     let expectedContents =@@ -316,10 +213,42 @@             <> "include john/2019-include.journal\n"     assertEqual "Top-level year include should reference the owner include" expectedContents finalContents -    _ <- writeIncludesUpTo (defaultOpts tmpdirAbsPath) ch stopAt []+    _ <- writeIncludes (defaultOpts tmpdirAbsPath) ch stopAt []     emptyIndex <- T.readFile (tmpdir </> "import" </> "all-years.journal")     assertEqual "An empty import has a readable index" (includePreamble <> "\n") emptyIndex +testDiscoveredManualIncludes :: Test+testDiscoveredManualIncludes = TestCase $ withTestDir $ \base -> do+  let root = Path.toFilePath base </> "import"+      owner = root </> "john"+      account = owner </> "bank" </> "checking"+      journal = account </> "3-journal/2020/march.journal"+      pre = owner </> "_manual_/2020/pre-import.journal"+      post = owner </> "_manual_/2020/post-import.journal"+      unrelated = owner </> "2021-include.journal"+  touchAll [journal, pre, post, unrelated,+            owner </> "_manual_/2022/notes.journal",+            owner </> "_manual_/20x3/post-import.journal",+            account </> ".trash/2024/_manual_/2024/post-import.journal"]+  T.writeFile unrelated "; handwritten include, leave alone\n"+  stopAt <- Path.parseAbsDir root+  input <- Path.parseAbsFile journal+  ch <- newTChanIO+  _ <- writeIncludes (defaultOpts base) ch stopAt [input]+  contents <- T.readFile (owner </> "2020-include.journal")+  assertEqual "Discovered manual files surround generated children exactly once"+    (includePreamble <> "\ninclude _manual_/2020/pre-import.journal\ninclude bank/2020-include.journal\ninclude _manual_/2020/post-import.journal\n") contents+  index <- T.readFile (root </> "all-years.journal")+  assertEqual "Only supported manual paths establish years"+    (includePreamble <> "\ninclude 2020-include.journal\n") index+  mapM_ (\file -> Path.parseAbsFile file >>= PathIO.removeFile) ([journal, pre, post] :: [FilePath])+  _ <- writeIncludes (defaultOpts base) ch stopAt []+  mapM_ (\file -> do+      actual <- T.readFile file+      assertEqual "Retired year and account ledgers become empty" (includePreamble <> "\n") actual)+    ([owner </> "2020-include.journal", account </> "all-years.journal", root </> "2020-include.journal"] :: [FilePath])+  T.readFile unrelated >>= assertEqual "Do not clear handwritten indexes" "; handwritten include, leave alone\n"+ tests :: Test tests =   TestList@@ -328,7 +257,7 @@       testIncludesPrePost,       testIncludesOpeningClosing,       testIncludesPrices,-      testWriteIncludeFiles,       testWriteToplevelAllYearsInclude,-      testWriteIncludesUpTo+      testWriteIncludes,+      testDiscoveredManualIncludes     ]
test/Common/Integration.hs view
@@ -6,36 +6,79 @@  import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, tryTakeMVar) import Control.Concurrent.STM (atomically, newTChanIO, tryReadTChan)-import qualified Data.List as List (sort)+import Control.Exception (bracket, finally)+import Control.Monad (forM_, unless)+import qualified Data.List as List (intercalate, isInfixOf) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Time.Clock (UTCTime(..), addUTCTime, secondsToDiffTime) import Data.Time.Calendar (fromGregorian) import Hledger.Flow.Common-import qualified Hledger.Flow.PathHelpers as Paths import qualified Hledger.Flow.RuntimeOptions as RT import Hledger.Flow.Types (LogMessage (StdErr)) import qualified Path import qualified Path.IO as PathIO import System.Directory (doesFileExist)+import qualified System.Directory as Directory+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.IO.Error (tryIOError)+import qualified System.Info as Sys import System.Timeout (timeout) import Test.HUnit-import TestHelpers (defaultOpts, withTestDir)-import TestHelpersTurtle-import System.FilePath ((</>), normalise)+import TestHelpers (defaultOpts, withTestDir, touchAll)+import System.FilePath ((</>), searchPathSeparator) -testHiddenFiles :: Test-testHiddenFiles = TestCase $ withTestDir $ \base -> do-  let paths = map (Path.toFilePath base </>) (journalFiles ++ extraFiles ++ hiddenFiles)-  touchAll paths-  found <- Paths.findFilesIn (const True) [] base-  let expected = map (Path.toFilePath base </>) (journalFiles ++ extraFiles)-  assertEqual "Hidden files should be excluded"-    (List.sort (map normalise expected)) (List.sort (map Path.toFilePath found))+-- HUnit runs these cases sequentially; restore process-wide PATH even on failure.+withSearchPath :: [FilePath] -> IO a -> IO a+withSearchPath dirs action = bracket (lookupEnv "PATH") restore $ \_ -> do+  setEnv "PATH" (List.intercalate [searchPathSeparator] dirs)+  action+  where+    restore = maybe (unsetEnv "PATH") (setEnv "PATH") +testHledgerLookup :: Test+testHledgerLookup = TestLabel "hledger executable lookup" $ TestCase $ withTestDir $ \base -> do+  let root = Path.toFilePath base+      name = "hledger" ++ Directory.exeExtension+      first = root </> "first bin" </> name+      second = root </> "second" </> name+      check dirs expected = withSearchPath dirs $ do+        result <- tryIOError (hledgerPathFromOption Nothing)+        case result of+          Left err -> assertFailure ("lookup in " ++ show dirs ++ ": " ++ show err)+          Right actual -> do+            expectedPath <- Directory.canonicalizePath expected+            assertEqual ("lookup in " ++ show dirs) expectedPath (Path.toFilePath actual)+  forM_ (["first bin", "second", "work", "empty"] :: [FilePath]) $ \dir ->+    Directory.createDirectory (root </> dir)+  forM_ ([first, second] :: [FilePath]) $ \file -> do+    writeFile file ""+    perms <- Directory.getPermissions file+    Directory.setPermissions file (Directory.setOwnerExecutable True perms)+  Directory.withCurrentDirectory root $ do+    check ["first bin"] first+    check [root </> "first bin"] first+    check ["first bin", root </> "second"] first+    check ["second", "first bin"] second+    Directory.withCurrentDirectory (root </> "first bin") $ check ["."] first+    Directory.withCurrentDirectory (root </> "work") $ check [".." </> "first bin"] first+    withSearchPath ["second"] $ do+      actual <- hledgerPathFromOption (Just first)+      assertEqual "explicit path overrides PATH" first (Path.toFilePath actual)+    withSearchPath ["empty"] $ do+      result <- tryIOError (hledgerPathFromOption Nothing)+      case result of+        Left err -> assertBool "missing executable diagnostic"+          ("Unable to find hledger" `List.isInfixOf` show err)+        Right actual -> assertFailure ("unexpected executable: " ++ show actual)+    -- Windows symlinks require privileges; .exe lookup above runs on every OS.+    unless (Sys.os == "mingw32") $ do+      Directory.createFileLink ("first bin" </> name) (root </> name)+      check ["."] first+ testFilterPaths :: Test testFilterPaths = TestCase $ withTestDir $ \base -> do-  let onDisk = map (Path.toFilePath base </>) (journalFiles ++ extraFiles ++ hiddenFiles)+  let onDisk = map (Path.toFilePath base </>) (["first.journal", "nested/second.journal"] :: [FilePath])       missing = map (Path.toFilePath base </>) ["where", "is", "my", "mind"]   touchAll onDisk   filtered <- filterPaths doesFileExist (missing ++ onDisk)@@ -118,5 +161,25 @@   result <- timeout 10000000 (parBatchedActions 2 [0] [first, second, third])   assertEqual "preserve input order across parallel batches" (Just [0, 1, 2, 3]) result +testBatchFailure :: Test+testBatchFailure = TestLabel "batch failure cancels siblings and stops later batches" $+  TestList [TestCase (checkBatchFailure id), TestCase (checkBatchFailure reverse)]++checkBatchFailure :: ([IO ()] -> [IO ()]) -> Assertion+checkBatchFailure order = do+  started <- newEmptyMVar+  stopped <- newEmptyMVar+  never <- newEmptyMVar+  later <- newEmptyMVar+  let failing = takeMVar started >> ioError (userError "conversion failed")+      running = (putMVar started () >> takeMVar never) `finally` putMVar stopped ()+      nextBatch = putMVar later ()+  result <- timeout 10000000 (tryIOError (parBatchedActions 2 [] (order [failing, running] ++ [nextBatch])))+  case result of+    Just (Left err) -> assertBool "propagate the original failure" ("conversion failed" `List.isInfixOf` show err)+    _ -> assertFailure ("expected a prompt batch failure, got " ++ show result)+  tryTakeMVar stopped >>= assertEqual "cancel and join the running sibling" (Just ())+  tryTakeMVar later >>= assertEqual "never start the next batch" Nothing+ tests :: Test-tests = TestList [testHiddenFiles, testFilterPaths, testFirstExistingFile, testVerboseTestFile, testNeedsRegeneration, testBatchOrder]+tests = TestList [testHledgerLookup, testFilterPaths, testFirstExistingFile, testVerboseTestFile, testNeedsRegeneration, testBatchOrder, testBatchFailure]
test/Common/Unit.hs view
@@ -10,6 +10,7 @@ import Hledger.Flow.RuntimeOptions (RuntimeOptions (hledgerConf)) import qualified Data.List as List import qualified Data.Map.Strict as Map+import qualified Data.Text as T import Path ((</>), reldir) import Test.HUnit import TestHelpers (defaultOpts, testRoot)@@ -29,6 +30,16 @@         let expected = "--number '/tmp/file with spaces'"         let actual = showCmdArgs opts         assertEqual "Convert command-line arguments to text" expected actual+        mapM_ (\(arg, quoted) -> assertEqual ("Quote literal argument " ++ show arg) quoted (escapeArg arg))+          ([ ("", "''"),+            ("Morgan's Saturday", "'Morgan'\"'\"'s Saturday'"),+            ("O'Brien", "'O'\"'\"'Brien'"),+            ("$(echo injected);*", "'$(echo injected);*'"),+            ("a\tb\nc", "'a\tb\nc'"),+            ("a\"b", "'a\"b'"),+            ("a\\b", "'a\\b'"),+            ("--file=import/2016-include.journal", "--file=import/2016-include.journal")+          ] :: [(T.Text, T.Text)])     )  testHledgerConfArgs :: Test@@ -98,31 +109,6 @@         assertEqual "Extract digits from text 2" expected2 actual2     ) -testChangePathAndExtension :: Test-testChangePathAndExtension =-  TestCase-    ( do-        let src1 = "import/john/bank/acc/1-in/2018/2018-06-30.csv"-        let expected1 = "import/john/bank/acc/3-journal/2018/2018-06-30.journal"-        let actual1 = changePathAndExtension "3-journal/" "journal" src1-        assertEqual "Change 1-in to 3-journal and extension" expected1 actual1--        let src2 = "import/john/bank/acc/2-preprocessed/2018/2018-06-30.csv"-        let expected2 = "import/john/bank/acc/3-journal/2018/2018-06-30.journal"-        let actual2 = changePathAndExtension "3-journal/" "journal" src2-        assertEqual "Change 2-preprocessed to 3-journal and extension" expected2 actual2--        let src3 = "import/john/bank/acc/3-journal/2018/2018-06-30.csv"-        let expected3 = "import/john/bank/acc/3-journal/2018/2018-06-30.journal"-        let actual3 = changePathAndExtension "3-journal/" "journal" src3-        assertEqual "Leave other directories intact, only change extension" expected3 actual3--        let nativeInput = FilePath.joinPath ["import", "john", "bank", "acc", "1-in", "2018", "statement.csv"]-        let nativeExpected = FilePath.joinPath ["import", "john", "bank", "acc", "3-journal", "2018", "statement.journal"]-        assertEqual "Change the input directory with native path separators" nativeExpected-          (FilePath.normalise $ changePathAndExtension "3-journal/" "journal" nativeInput)-    )- testGroupValuesBy :: Test testGroupValuesBy =   TestCase@@ -135,4 +121,4 @@     )  tests :: Test-tests = TestList [testDocURL, testShowCmdArgs, testHledgerConfArgs, testRelativeToBase, testExtractDigits, testChangePathAndExtension, testGroupValuesBy]+tests = TestList [testDocURL, testShowCmdArgs, testHledgerConfArgs, testRelativeToBase, testExtractDigits, testGroupValuesBy]
test/ImportHelpers/Integration.hs view
@@ -6,10 +6,13 @@ import qualified Data.List as List import Data.Either (isLeft) import qualified Data.Text.IO as T-import Hledger.Flow.Import.ImportHelpers (findInputFiles, findJournalFiles, withStagedOutput)+import Hledger.Flow.Import.ImportHelpers (withStagedOutput)+import Hledger.Flow.Import.Inventory+import TestHelpers (withTestDir, touchAll) import Hledger.Flow.PathHelpers (AbsFile) import Path import Path.IO+import qualified System.FilePath import System.IO.Error (tryIOError) import Test.HUnit @@ -18,53 +21,43 @@   createDirIfMissing True (parent f)   T.writeFile (toFilePath f) "x" -testFindInputFiles :: Test-testFindInputFiles =-  TestCase-    ( do-        cwd <- getCurrentDir-        let tmpbase = cwd </> [reldir|test|] </> [reldir|tmp|]-        createDirIfMissing True tmpbase-        withTempDir tmpbase "hlflowtest" $ \tmpdir -> do-          let file2018 = tmpdir </> [relfile|import/john/mybank/checking/1-in/2018/2018-01-01.csv|]-          let file2019 = tmpdir </> [relfile|import/john/mybank/checking/1-in/2019/2019-01-01.csv|]-          let file2020 = tmpdir </> [relfile|import/john/mybank/checking/1-in/2020/2020-01-01.csv|]-          let hidden = tmpdir </> [relfile|import/john/mybank/checking/1-in/2019/.hidden.csv|]-          let wrongYear = tmpdir </> [relfile|import/john/mybank/checking/1-in/20a0/20a0-01-01.csv|]-          let nested = tmpdir </> [relfile|import/john/mybank/checking/1-in/2019/subdir/2019-02-01.csv|]-          let preprocessed = tmpdir </> [relfile|import/john/mybank/checking/2-preprocessed/2019/pre.csv|]-          let manual = tmpdir </> [relfile|import/john/_manual_/2019/manual.journal|]-          let journal = tmpdir </> [relfile|import/john/mybank/checking/3-journal/2019/2019-01-01.journal|]--          mapM_ touchFile [file2018, file2019, file2020, hidden, wrongYear, nested, preprocessed, manual, journal]--          actual <- findInputFiles 2019 tmpdir-          let expected = List.sort [file2019, file2020]-          assertEqual "findInputFiles should return only year directories >= startYear, excluding hidden and excluded dirs" expected (List.sort actual)-    )--testFindJournalFiles :: Test-testFindJournalFiles =-  TestCase-    ( do-        cwd <- getCurrentDir-        let tmpbase = cwd </> [reldir|test|] </> [reldir|tmp|]-        createDirIfMissing True tmpbase-        withTempDir tmpbase "hlflowtest" $ \tmpdir -> do-          let journal2018 = tmpdir </> [relfile|import/john/mybank/checking/3-journal/2018/2018-01-01.journal|]-          let journal2019 = tmpdir </> [relfile|import/john/mybank/checking/3-journal/2019/2019-01-01.journal|]-          let hidden = tmpdir </> [relfile|import/john/mybank/checking/3-journal/2019/.hidden.journal|]-          let wrongYear = tmpdir </> [relfile|import/john/mybank/checking/3-journal/20a0/20a0-01-01.journal|]-          let nested = tmpdir </> [relfile|import/john/mybank/checking/3-journal/2019/subdir/2019-02-01.journal|]-          let input = tmpdir </> [relfile|import/john/mybank/checking/1-in/2019/2019-01-01.csv|]-          let preprocessed = tmpdir </> [relfile|import/john/mybank/checking/2-preprocessed/2019/pre.csv|]--          mapM_ touchFile [journal2018, journal2019, hidden, wrongYear, nested, input, preprocessed]--          actual <- findJournalFiles tmpdir-          let expected = List.sort [journal2018, journal2019]-          assertEqual "findJournalFiles should return only journal directory files, excluding hidden and excluded dirs" expected (List.sort actual)-    )+testInventory :: Test+testInventory = TestLabel "active inventory discovery and scope" $ TestCase $ withTestDir $ \base -> do+  let root = base </> [reldir|import|]+      account = root </> [reldir|owner/bank/checking|]+      inputs = [ "owner/bank/checking/1-in/2018/old.csv",+                 "owner/bank/checking/1-in/2019/march.bank.txt",+                 "owner/bank/checking/1-in/2020/new.csv",+                 "2-preprocessed/3-journal/1-in/1-in/2019/reserved.csv" ]+      others = [ "owner/bank/checking/2-preprocessed/2019/march.bank.csv",+                 "owner/bank/checking/3-journal/2019/march.bank.journal",+                 "owner/_manual_/2019/post-import.journal",+                 "owner/bank/checking/1-in/20a0/bad.csv",+                 "owner/bank/checking/1-in/20190/bad.csv",+                 "owner/bank/checking/1-in/2019/nested/bad.csv" ]+      hidden = [ "owner/bank/checking/1-in/2019/.hidden.csv",+                 ".hidden/bank/account/1-in/2019/bad.csv",+                 "owner/bank/checking/.trash/1-in/2019/bad.csv",+                 "owner/bank/checking/1-in/__pycache__/2019/bad.csv" ]+      absolute = (toFilePath root System.FilePath.</>)+  touchAll (map absolute (inputs ++ others ++ hidden))+  inventory <- findImportFiles root+  expected <- mapM (parseAbsFile . absolute) (inputs ++ others)+  assertEqual "exclude hidden files, hidden directories and Python cache" (List.sort expected) inventory+  sources <- mapM (parseAbsFile . absolute) inputs+  assertEqual "only direct children of a valid input year" (List.sort sources)+    (stageFiles root [reldir|1-in|] inventory)+  selected <- mapM (parseAbsFile . absolute) (take 2 (drop 1 inputs))+  assertEqual "account scope and inclusive start year" selected+    (filter (inImportScope account 2019) (stageFiles root [reldir|1-in|] inventory))+  let source = account </> [relfile|1-in/2019/march.bank.txt|]+  generatedOutput [reldir|2-preprocessed|] ".csv" source >>= assertEqual "keep earlier filename extensions"+    (account </> [relfile|2-preprocessed/2019/march.bank.csv|])+  generatedOutput [reldir|3-journal|] ".journal" source >>= assertEqual "journal destination"+    (account </> [relfile|3-journal/2019/march.bank.journal|])+  assertEqual "discover generated journals separately"+    [account </> [relfile|3-journal/2019/march.bank.journal|]]+    (stageFiles root [reldir|3-journal|] inventory)  testStagedOutput :: Test testStagedOutput = TestCase $ withSystemTempDir "hlflow-output" $ \dir -> do@@ -88,4 +81,19 @@   T.readFile (toFilePath target) >>= assertEqual "publish successful retry" "complete"  tests :: Test-tests = TestList [testFindInputFiles, testFindJournalFiles, testStagedOutput]+tests = TestList [testInventory, testStagedOutput, testTrashLock]++testTrashLock :: Test+testTrashLock = TestCase $ withSystemTempDir "hlflow-trash" $ \root -> do+  let source = root </> [relfile|import/owner/bank/account/3-journal/2020/march.journal|]+      lock = root </> [reldir|import/owner/bank/account/.trash/.move-lock|]+      target = root </> [relfile|import/owner/bank/account/.trash/2020/3-journal/march.journal|]+  touchFile source+  createDirIfMissing True lock+  result <- tryIOError (moveToTrash source)+  assertBool "A concurrent trash move must not race for a destination" (isLeft result)+  T.readFile (toFilePath source) >>= assertEqual "Busy trash leaves source intact" "x"+  doesFileExist target >>= assertBool "Busy trash writes no destination" . not+  removeDir lock+  actual <- moveToTrash source+  assertEqual "Retry after the other move completes succeeds" target actual
test/TestHelpers.hs view
@@ -4,13 +4,14 @@  module TestHelpers where -import Data.Maybe (fromMaybe) import Hledger.Flow.Internals (SystemInfo (..), versionInfo)-import Hledger.Flow.PathHelpers (AbsDir, RelFile)+import Hledger.Flow.PathHelpers (AbsDir) import Hledger.Flow.RuntimeOptions import qualified Hledger.Flow.Types as FlowTypes import Path import qualified Path.IO as PathIO+import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeDirectory) import qualified System.Info as Sys  withTestDir :: (AbsDir -> IO ()) -> IO ()@@ -60,141 +61,7 @@       prettyReports = True     } -toJournal :: RelFile -> RelFile-toJournal inFile = do-  let journalFile = fromMaybe [relfile|oops.err|] $ replaceExtension ".journal" inFile-  let journalName = filename journalFile-  let yearDir = dirname . parent $ inFile-  (parent . parent . parent) inFile </> [reldir|3-journal|] </> yearDir </> journalName--inputJohnSavings2017 :: [RelFile]-inputJohnSavings2017 =-  [ [relfile|import/john/bogartbank/savings/1-in/2017/2017-11-30.csv|],-    [relfile|import/john/bogartbank/savings/1-in/2017/2017-12-30.csv|]-  ]--johnSavingsJournals2017 :: [RelFile]-johnSavingsJournals2017 = map toJournal inputJohnSavings2017--inputJohnSavings2018 :: [RelFile]-inputJohnSavings2018 =-  [ [relfile|import/john/bogartbank/savings/1-in/2018/2018-02-30.csv|],-    [relfile|import/john/bogartbank/savings/1-in/2018/2018-01-30.csv|]-  ]--johnSavingsJournals2018 :: [RelFile]-johnSavingsJournals2018 = map toJournal inputJohnSavings2018--inputJohnChecking2018 :: [RelFile]-inputJohnChecking2018 =-  [ [relfile|import/john/bogartbank/checking/1-in/2018/2018-11-30.csv|],-    [relfile|import/john/bogartbank/checking/1-in/2018/2018-10-30.csv|],-    [relfile|import/john/bogartbank/checking/1-in/2018/2018-12-30.csv|]-  ]--johnCheckingJournals2018 :: [RelFile]-johnCheckingJournals2018 = map toJournal inputJohnChecking2018--inputJohnChecking2019 :: [RelFile]-inputJohnChecking2019 =-  [ [relfile|import/john/bogartbank/checking/1-in/2019/2019-01-30.csv|],-    [relfile|import/john/bogartbank/checking/1-in/2019/2019-02-30.csv|]-  ]--johnCheckingJournals2019 :: [RelFile]-johnCheckingJournals2019 = map toJournal inputJohnChecking2019--inputJohnBogart :: [RelFile]-inputJohnBogart = inputJohnSavings2017 <> inputJohnSavings2018 <> inputJohnChecking2018 <> inputJohnChecking2019--johnCC2017 :: RelFile-johnCC2017 = [relfile|import/john/otherbank/creditcard/1-in/2017/2017-12-30.csv|]--johnCCJournal2017 :: RelFile-johnCCJournal2017 = toJournal johnCC2017--johnCC2018 :: RelFile-johnCC2018 = [relfile|import/john/otherbank/creditcard/1-in/2018/2018-01-30.csv|]--johnCCJournal2018 :: RelFile-johnCCJournal2018 = toJournal johnCC2018--johnInvest2018 :: RelFile-johnInvest2018 = [relfile|import/john/otherbank/investments/1-in/2018/2018-12-30.csv|]--johnInvestJournal2018 :: RelFile-johnInvestJournal2018 = toJournal johnInvest2018--johnInvest2019 :: RelFile-johnInvest2019 = [relfile|import/john/otherbank/investments/1-in/2019/2019-01-30.csv|]--johnInvestJournal2019 :: RelFile-johnInvestJournal2019 = toJournal johnInvest2019--inputJohnOther :: [RelFile]-inputJohnOther = [johnCC2017, johnCC2018, johnInvest2018, johnInvest2019]--janeSavings2017 :: RelFile-janeSavings2017 = [relfile|import/jane/bogartbank/savings/1-in/2017/2017-12-30.csv|]--janeSavings2018 :: [RelFile]-janeSavings2018 =-  [ [relfile|import/jane/bogartbank/savings/1-in/2018/2018-01-30.csv|],-    [relfile|import/jane/bogartbank/savings/1-in/2018/2018-12-30.csv|]-  ]--janeSavings2019 :: RelFile-janeSavings2019 = [relfile|import/jane/bogartbank/savings/1-in/2019/2019-01-30.csv|]--inputJaneBogart :: [RelFile]-inputJaneBogart =-  [ janeSavings2017,-    [relfile|import/jane/bogartbank/savings/3-journals/2018/2018-01-30.journal|],-    [relfile|import/jane/bogartbank/savings/3-journals/2018/2018-12-30.journal|],-    janeSavings2019-  ]--janeSavingsJournal2017 :: RelFile-janeSavingsJournal2017 = toJournal janeSavings2017--janeSavingsJournals2018 :: [RelFile]-janeSavingsJournals2018 = map toJournal janeSavings2018--janeSavingsJournal2019 :: RelFile-janeSavingsJournal2019 = toJournal janeSavings2019--janeSavingsJournals :: [RelFile]-janeSavingsJournals = [janeSavingsJournal2017] ++ janeSavingsJournals2018 ++ [janeSavingsJournal2019]--janeCC2017 :: RelFile-janeCC2017 = [relfile|import/jane/otherbank/creditcard/1-in/2017/2017-12-30.csv|]--janeCCJournal2017 :: RelFile-janeCCJournal2017 = toJournal janeCC2017--janeCC2018 :: RelFile-janeCC2018 = [relfile|import/jane/otherbank/creditcard/1-in/2018/2018-01-30.csv|]--janeCCJournal2018 :: RelFile-janeCCJournal2018 = toJournal janeCC2018--janeInvest2018 :: RelFile-janeInvest2018 = [relfile|import/jane/otherbank/investments/1-in/2018/2018-12-30.csv|]--janeInvestJournal2018 :: RelFile-janeInvestJournal2018 = toJournal janeInvest2018--janeInvest2019 :: RelFile-janeInvest2019 = [relfile|import/jane/otherbank/investments/1-in/2019/2019-01-30.csv|]--janeInvestJournal2019 :: RelFile-janeInvestJournal2019 = toJournal janeInvest2019--inputJaneOther :: [RelFile]-inputJaneOther = [janeCC2017, janeCC2018, janeInvest2018, janeInvest2019]--inputFiles :: [RelFile]-inputFiles = inputJohnBogart <> inputJohnOther <> inputJaneBogart <> inputJaneOther--journalFiles :: [RelFile]-journalFiles = map toJournal inputFiles+touchAll :: [FilePath] -> IO ()+touchAll = mapM_ $ \file -> do+  createDirectoryIfMissing True (takeDirectory file)+  appendFile file ""
− test/TestHelpersTurtle.hs
@@ -1,76 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module TestHelpersTurtle where--import Hledger.Flow.Common (changePathAndExtension)-import System.Directory (createDirectoryIfMissing)-import System.FilePath (takeDirectory)--inputJohnBogart :: [FilePath]-inputJohnBogart =-  [ "import/john/bogartbank/savings/1-in/2017/2017-11-30.csv",-    "import/john/bogartbank/savings/1-in/2017/2017-12-30.csv",-    "import/john/bogartbank/savings/1-in/2018/2018-02-30.csv",-    "import/john/bogartbank/savings/1-in/2018/2018-01-30.csv",-    "import/john/bogartbank/checking/1-in/2018/2018-11-30.csv",-    "import/john/bogartbank/checking/1-in/2018/2018-10-30.csv",-    "import/john/bogartbank/checking/1-in/2018/2018-12-30.csv",-    "import/john/bogartbank/checking/1-in/2019/2019-01-30.csv",-    "import/john/bogartbank/checking/1-in/2019/2019-02-30.csv"-  ]--inputJohnOther :: [FilePath]-inputJohnOther =-  [ "import/john/otherbank/creditcard/1-in/2017/2017-12-30.csv",-    "import/john/otherbank/creditcard/1-in/2018/2018-01-30.csv",-    "import/john/otherbank/investments/1-in/2018/2018-12-30.csv",-    "import/john/otherbank/investments/1-in/2019/2019-01-30.csv"-  ]--inputJaneBogart :: [FilePath]-inputJaneBogart =-  [ "import/jane/bogartbank/savings/1-in/2017/2017-12-30.csv",-    "import/jane/bogartbank/savings/1-in/2018/2018-01-30.csv",-    "import/jane/bogartbank/checking/1-in/2018/2018-12-30.csv",-    "import/jane/bogartbank/checking/1-in/2019/2019-01-30.csv"-  ]--inputJaneOther :: [FilePath]-inputJaneOther =-  [ "import/jane/otherbank/creditcard/1-in/2017/2017-12-30.csv",-    "import/jane/otherbank/creditcard/1-in/2018/2018-01-30.csv",-    "import/jane/otherbank/investments/1-in/2018/2018-12-30.csv",-    "import/jane/otherbank/investments/1-in/2019/2019-01-30.csv"-  ]--inputFiles :: [FilePath]-inputFiles = inputJohnBogart <> inputJohnOther <> inputJaneBogart <> inputJaneOther--journalFiles :: [FilePath]-journalFiles = toJournals inputFiles ++ ignoredJournalFiles--ignoredJournalFiles :: [FilePath]-ignoredJournalFiles = ["import/john/bogartbank/checking/3-journal/2018/not-a-journal.pdf"]--extraFiles :: [FilePath]-extraFiles = ["import/john/bogartbank/savings/2017-opening.journal"]--hiddenFiles :: [FilePath]-hiddenFiles =-  [ ".hiddenfile",-    "checking/.DS_Store",-    "import/john/bogartbank/savings/1-in/.anotherhiddenfile",-    "import/john/bogartbank/checking/1-in/2018/.hidden",-    "import/john/bogartbank/checking/3-journal/2018/.hidden"-  ]--toJournals :: [FilePath] -> [FilePath]-toJournals = map (changePathAndExtension "3-journal/" "journal")--touchAll :: [FilePath] -> IO ()-touchAll = mapM_ superTouch--superTouch :: FilePath -> IO ()-superTouch file = do-  createDirectoryIfMissing True (takeDirectory file)-  appendFile file ""