hledger-flow 0.13.1.0 → 0.13.2.0

raw patch · 13 files changed

+267/−139 lines, 13 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +14/−0
• README.org +1/−1
• app/Main.hs +36/−14
• hledger-flow.cabal +2/−2
• src/Hledger/Flow/CSVImport.hs +8/−5
• src/Hledger/Flow/Common.hs +50/−31
• src/Hledger/Flow/Reports.hs +12/−5
• src/Hledger/Flow/RuntimeOptions.hs +5/−4
• test/CSVImport/Integration.hs +10/−10
• test/CSVImport/Unit.hs +26/−16
• test/Common/Integration.hs +79/−25
• test/Common/Unit.hs +23/−25
• test/TestHelpers.hs +1/−1

@@ -1,5 +1,19 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.13.2++Improve support for importing a subset of journals: start importing only from the directory given as argument,+or the current directory, and generate only the relevant include files.++This is a behavioural change and (for now) it needs to be enabled with the --enable-future-rundir switch.+This will become the default behaviour in 0.14.x, at which time the switch will be removed.++Reports:+Use the LEDGER_FILE env var (if set) when generating reports.+Default to the top-level all-years.journal if not set.++Build with Stackage Nightly 2020-03-10 (ghc-8.8.3)+ ## 0.13.1  - Automatically add [include lines for yearly price files](https://github.com/apauley/hledger-flow/#price-files) if they are present on disk.

@@ -18,7 +18,7 @@ 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 are done by =hledger=.+classified accounting journals is done by =hledger=.  =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

@@ -12,10 +12,13 @@ import Hledger.Flow.Reports import Hledger.Flow.CSVImport -data SubcommandParams = SubcommandParams { maybeBaseDir :: Maybe FilePath-                                         , maybeRunDir :: Maybe FilePath } deriving (Show)-data Command = Import SubcommandParams | Report SubcommandParams deriving (Show)+data ImportParams = ImportParams { maybeImportBaseDir :: Maybe FilePath+                                 , importUseRunDir :: Bool } deriving (Show) +data ReportParams = ReportParams { maybeReportBaseDir :: Maybe FilePath } deriving (Show)++data Command = Import ImportParams | Report ReportParams deriving (Show)+ data MainParams = MainParams { verbosity :: Int                              , hledgerPathOpt :: Maybe FilePath                              , showOpts :: Bool@@ -28,15 +31,16 @@   cmd <- options "An hledger workflow focusing on automated statement import and classification:\nhttps://github.com/apauley/hledger-flow#readme" baseCommandParser   case cmd of     Version                                -> stdout $ select versionInfo-    Command mainParams' (Import subParams) -> toRuntimeOptions mainParams' subParams >>= importCSVs-    Command mainParams' (Report subParams) -> toRuntimeOptions mainParams' subParams >>= generateReports+    Command mainParams' (Import subParams) -> toRuntimeOptionsImport mainParams' subParams >>= importCSVs+    Command mainParams' (Report subParams) -> toRuntimeOptionsReport mainParams' subParams >>= generateReports -toRuntimeOptions :: MainParams -> SubcommandParams -> IO RT.RuntimeOptions-toRuntimeOptions mainParams' subParams' = do-  bd <- determineBaseDir $ maybeBaseDir subParams'+toRuntimeOptionsImport :: MainParams -> ImportParams -> IO RT.RuntimeOptions+toRuntimeOptionsImport mainParams' subParams' = do+  (bd, runDir) <- determineBaseDir $ maybeImportBaseDir subParams'   hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams'   return RT.RuntimeOptions { RT.baseDir = bd-                           , RT.runDir = maybeRunDir subParams'+                           , RT.importRunDir = runDir+                           , RT.useRunDir = importUseRunDir subParams'                            , RT.hfVersion = versionInfo'                            , RT.hledgerInfo = hli                            , RT.sysInfo = systemInfo@@ -44,13 +48,27 @@                            , RT.showOptions = showOpts mainParams'                            , RT.sequential = sequential mainParams' } +toRuntimeOptionsReport :: MainParams -> ReportParams -> IO RT.RuntimeOptions+toRuntimeOptionsReport mainParams' subParams' = do+  (bd, _) <- determineBaseDir $ maybeReportBaseDir subParams'+  hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams'+  return RT.RuntimeOptions { RT.baseDir = bd+                           , RT.importRunDir = "./"+                           , RT.useRunDir = False+                           , RT.hfVersion = versionInfo'+                           , RT.hledgerInfo = hli+                           , RT.sysInfo = systemInfo+                           , RT.verbose = verbosity mainParams' > 0+                           , RT.showOptions = showOpts mainParams'+                           , RT.sequential = sequential mainParams' }+ baseCommandParser :: Parser BaseCommand baseCommandParser = (Command <$> verboseParser <*> commandParser)   <|> flag' Version (long "version" <> short 'V' <> help "Display version information")  commandParser :: Parser Command-commandParser = fmap Import (subcommand "import" "Converts electronic transactions into categorised journal files" subcommandParser)-  <|> fmap Report (subcommand "report" "Generate Reports" subcommandParser)+commandParser = fmap Import (subcommand "import" "Uses hledger with your own rules and/or scripts to convert electronic statements into categorised journal files" subcommandParserImport)+  <|> fmap Report (subcommand "report" "Generate Reports" subcommandParserReport)  verboseParser :: Parser MainParams verboseParser = MainParams@@ -59,7 +77,11 @@   <*> switch (long "show-options" <> help "Print the options this program will run with")   <*> switch (long "sequential" <> help "Disable parallel processing") -subcommandParser :: Parser SubcommandParams-subcommandParser = SubcommandParams+subcommandParserImport :: Parser ImportParams+subcommandParserImport = ImportParams+  <$> optional (argPath "dir" "The directory to import. Use the base directory for a full import or a sub-directory for a partial import. Defaults to the current directory. This behaviour is changing: see --enable-future-rundir")+  <*> switch (long "enable-future-rundir" <> help "Enable the future (0.14.x) default behaviour now: start importing only from the directory that was given as an argument, or the currect directory. Previously a full import was always done. This switch will be removed in 0.14.x")++subcommandParserReport :: Parser ReportParams+subcommandParserReport = ReportParams   <$> optional (argPath "basedir" "The hledger-flow base directory")-  <*> optional (strOption (long "experimental-rundir" <> help "A subdirectory of the base where the command will restrict itself to"))

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 617874a347909e345431628a3616c190537a585179618eb631c162fb36a81bff+-- hash: 735099a4aed6ae3be8f511959f660740e93a66852c0a4aeb4b1d3b29e7a951c8  name:           hledger-flow-version:        0.13.1.0+version:        0.13.2.0 synopsis:       An hledger workflow focusing on automated statement import and classification. description:    Please see the README on GitHub at <https://github.com/apauley/hledger-flow#readme> category:       Finance, Console

@@ -35,10 +35,12 @@  importCSVs' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [FilePath] importCSVs' opts ch = do-  channelOutLn ch "Collecting input files..."-  let effectiveDir = case runDir opts of-        Nothing -> (baseDir opts) </> "import"-        Just rd -> rd+  let baseImportDir = forceTrailingSlash $ (baseDir opts) </> "import"+  let runDir = forceTrailingSlash $ collapse $ (baseDir opts) </> (importRunDir opts)+  let effectiveDir = if useRunDir opts+        then if (forceTrailingSlash $ runDir </> "import") == baseImportDir then baseImportDir else runDir+        else baseImportDir+  channelOutLn ch $ format ("Collecting input files from "%fp) effectiveDir   (inputFiles, diff) <- time $ single . shellToList . onlyFiles $ find inputFilePattern effectiveDir   let fileCount = length inputFiles   if (fileCount == 0) then@@ -52,7 +54,8 @@       channelOutLn ch $ format ("Found "%d%" input files in "%s%". Proceeding with import...") fileCount (repr diff)       let actions = map (extractAndImport opts ch) inputFiles :: [IO FilePath]       importedJournals <- parAwareActions opts actions-      sh $ writeIncludesUpTo opts ch "import" importedJournals+      _ <- writeIncludesUpTo opts ch effectiveDir importedJournals+      _ <- writeToplevelAllYearsInclude opts       return importedJournals  extractAndImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> IO FilePath

@@ -211,7 +211,8 @@ relativeToBase opts = relativeToBase' (baseDir opts)  relativeToBase' :: FilePath -> FilePath -> FilePath-relativeToBase' bd p = fromMaybe p $ stripPrefix (forceTrailingSlash bd) p+relativeToBase' bd p = if forceTrailingSlash bd == forceTrailingSlash p then "./" else+  fromMaybe p $ stripPrefix (forceTrailingSlash bd) p  groupPairs' :: (Eq a, Ord a) => [(a, b)] -> [(a, [b])] groupPairs' = map (\ll -> (fst . head $ ll, map snd ll)) . List.groupBy ((==) `on` fst)@@ -238,6 +239,9 @@ allYearsPath' :: (FilePath -> FilePath) -> FilePath -> FilePath allYearsPath' dir p = dir p </> "all-years.journal" +allYearsFileName :: FilePath+allYearsFileName = "all-years" <.> "journal"+ groupIncludeFiles :: [FilePath] -> (InputFileBundle, InputFileBundle) groupIncludeFiles = allYearIncludeFiles . groupIncludeFilesPerYear @@ -320,22 +324,22 @@ includeFileName :: FilePath -> FilePath includeFileName = (<.> "journal") . fromText . (format (fp%"-include")) . dirname -toIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> Shell (Map.Map FilePath Text)+toIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> IO (Map.Map FilePath Text) toIncludeFiles opts ch m = do   preMap  <- extraIncludes opts ch (Map.keys m) ["opening.journal"] ["pre-import.journal"] []   postMap <- extraIncludes opts ch (Map.keys m) ["closing.journal"] ["post-import.journal"] ["prices.journal"]   return $ (addPreamble . toIncludeFiles' preMap postMap) m -extraIncludes :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> [Text] -> [FilePath] -> [FilePath] -> Shell InputFileBundle+extraIncludes :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> [Text] -> [FilePath] -> [FilePath] -> IO InputFileBundle extraIncludes opts ch = extraIncludes' opts ch Map.empty -extraIncludes' :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> [FilePath] -> [Text] -> [FilePath] -> [FilePath] -> Shell InputFileBundle+extraIncludes' :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> [FilePath] -> [Text] -> [FilePath] -> [FilePath] -> IO InputFileBundle extraIncludes' _ _ acc [] _ _ _ = return acc extraIncludes' opts ch acc (file:files) extraSuffixes manualFiles prices = do   extra <- extraIncludesForFile opts ch file extraSuffixes manualFiles prices   extraIncludes' opts ch (Map.unionWith (++) acc extra) files extraSuffixes manualFiles prices -extraIncludesForFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> [Text] -> [FilePath] -> [FilePath] -> Shell InputFileBundle+extraIncludesForFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> [Text] -> [FilePath] -> [FilePath] -> IO InputFileBundle extraIncludesForFile opts ch file extraSuffixes manualFiles prices = do   let dirprefix = fromText $ fst $ T.breakOn "-" $ format fp $ basename file   let fileNames = map (\suff -> fromText $ format (fp%"-"%s) dirprefix suff) extraSuffixes@@ -343,11 +347,11 @@   let suffixDirFiles = map (directory file </> "_manual_" </> dirprefix </>) manualFiles   let priceFiles = map (directory file </> ".." </> "prices" </> dirprefix </>) prices   let extraFiles = suffixFiles ++ suffixDirFiles ++ priceFiles-  filtered <- filterPaths testfile extraFiles+  filtered <- single $ filterPaths testfile extraFiles   let logMsg = format ("Looking for possible extra include files for '"%fp%"' among these "%d%" options: "%s%". Found "%d%": "%s)                (relativeToBase opts file) (length extraFiles) (repr $ relativeFilesAsText opts extraFiles)                (length filtered) (repr $ relativeFilesAsText opts filtered)-  liftIO $ logVerbose opts ch logMsg+  logVerbose opts ch logMsg   return $ Map.fromList [(file, filtered)]  relativeFilesAsText :: HasBaseDir o => o -> [FilePath] -> [Text]@@ -373,39 +377,42 @@ includePreamble :: Text includePreamble = "### Generated by hledger-flow - DO NOT EDIT ###\n" -groupAndWriteIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> Shell [FilePath]+groupAndWriteIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> IO [FilePath] groupAndWriteIncludeFiles opts ch = writeFileMap opts ch . groupIncludeFiles -writeFiles :: Shell (Map.Map FilePath Text) -> Shell [FilePath]+writeFiles :: IO (Map.Map FilePath Text) -> IO [FilePath] writeFiles fileMap = do   m <- fileMap   writeFiles' m -writeFiles' :: Map.Map FilePath Text -> Shell [FilePath]+writeFiles' :: Map.Map FilePath Text -> IO [FilePath] writeFiles' fileMap = do-  liftIO $ writeTextMap fileMap+  writeTextMap fileMap   return $ Map.keys fileMap  writeTextMap :: Map.Map FilePath Text -> IO () writeTextMap = Map.foldlWithKey (\a k v -> a <> writeTextFile k v) (return ()) -writeFileMap :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> (InputFileBundle, InputFileBundle) -> Shell [FilePath]+writeFileMap :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> (InputFileBundle, InputFileBundle) -> 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 -> FilePath -> [FilePath] -> Shell [FilePath]+writeIncludesUpTo :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> FilePath -> [FilePath] -> IO [FilePath] writeIncludesUpTo _ _ _ [] = return []-writeIncludesUpTo opts ch stopAt paths = do-  let shouldStop = any (\dir -> dir == stopAt) $ map dirname paths+writeIncludesUpTo opts ch stopAt journalFiles = do+  let shouldStop = any (\dir -> dir == stopAt) $ map parent journalFiles   if shouldStop-    then do-      let allTop = groupValuesBy (allYearsPath' (parent . parent)) paths-      writeFileMap opts ch (Map.empty, allTop)+    then return journalFiles     else do-      newPaths <- groupAndWriteIncludeFiles opts ch paths-      writeIncludesUpTo opts ch stopAt newPaths+      newJournalFiles <- groupAndWriteIncludeFiles opts ch journalFiles+      writeIncludesUpTo opts ch stopAt newJournalFiles +writeToplevelAllYearsInclude :: (HasBaseDir o, HasVerbosity o) => o -> IO [FilePath]+writeToplevelAllYearsInclude opts = do+  let allTop = Map.singleton (baseDir opts </> allYearsFileName) ["import" </> allYearsFileName]+  writeFiles' $ (addPreamble . toIncludeFiles' Map.empty Map.empty) allTop+ changeExtension :: Text -> FilePath -> FilePath changeExtension ext path = (dropExtension path) <.> ext @@ -422,30 +429,42 @@                                        %"Have a look at the documentation for more information:\n"%s%"\n")                                startDir (docURL "getting-started") -determineBaseDir :: Maybe FilePath -> IO FilePath+determineBaseDir :: Maybe FilePath -> IO (FilePath, FilePath) determineBaseDir (Just suppliedDir) = determineBaseDir' suppliedDir determineBaseDir Nothing = pwd >>= determineBaseDir' -determineBaseDir' :: FilePath -> IO FilePath+determineBaseDir' :: FilePath -> IO (FilePath, FilePath) determineBaseDir' startDir = do   currentDir <- pwd   let absoluteStartDir = if relative startDir then collapse (currentDir </> startDir) else startDir-  ebd <- determineBaseDir'' absoluteStartDir absoluteStartDir+  ebd <- determineBaseDirFromAbsoluteStartDir absoluteStartDir   case ebd of     Right bd -> return bd     Left  t  -> die t -determineBaseDir'' :: FilePath -> FilePath -> IO (Either Text FilePath)-determineBaseDir'' startDir currentDir = do-  foundBaseDir <- testdir $ currentDir </> "import"-  if foundBaseDir-    then return $ Right $ forceTrailingSlash currentDir+determineBaseDirFromAbsoluteStartDir :: FilePath -> IO (Either Text (FilePath, FilePath))+determineBaseDirFromAbsoluteStartDir absoluteStartDir = determineBaseDirFromAbsoluteStartDir' absoluteStartDir absoluteStartDir++determineBaseDirFromAbsoluteStartDir' :: FilePath -> FilePath -> IO (Either Text (FilePath, FilePath))+determineBaseDirFromAbsoluteStartDir' startDir possibleBaseDir = do+  possibleBDExists <- testdir possibleBaseDir+  if not possibleBDExists then return $ Left $ format ("The provided directory does not exist: "%fp) possibleBaseDir     else-    do-      let doneSearching = (currentDir `elem` ["/", "./"])+    if relative startDir || relative possibleBaseDir then+    return $ Left $ format ("Internal error: found a relative path when expecting only absolute paths:\n"%fp%"\n"%fp%"\n") startDir possibleBaseDir+    else do+    foundBaseDir <- testdir $ possibleBaseDir </> "import"+    if foundBaseDir then+      do+      let baseD = forceTrailingSlash possibleBaseDir+      let runDir = forceTrailingSlash $ relativeToBase' baseD startDir+      return $ Right $ (baseD, runDir)+    else do+      let doneSearching = (possibleBaseDir `elem` ["/", "./"])       if doneSearching         then return $ Left $ errorMessageBaseDir startDir-        else determineBaseDir'' startDir $ parent currentDir+        else determineBaseDirFromAbsoluteStartDir' startDir $ parent possibleBaseDir+  dirOrPwd :: Maybe FilePath -> IO FilePath dirOrPwd maybeBaseDir = fmap forceTrailingSlash (fromMaybe pwd $ fmap realpath maybeBaseDir)

@@ -10,6 +10,7 @@ import Hledger.Flow.Common import Control.Concurrent.STM import Data.Either+import Data.Maybe  import qualified Data.Text as T import qualified Hledger.Flow.Types as FlowTypes@@ -44,10 +45,16 @@                <> "https://github.com/apauley/hledger-flow/issues\n"   channelOutLn ch wipMsg   owners <- single $ shellToList $ listOwners opts-  let aggregateJournal = journalFile opts []+  ledgerEnvValue <- need "LEDGER_FILE" :: IO (Maybe Text)+  let hledgerJournal = fromMaybe (baseDir opts </> allYearsFileName) $ fmap fromText ledgerEnvValue+  hledgerJournalExists <- testfile hledgerJournal+  _ <- if not hledgerJournalExists then die $ format ("Unable to find journal file: "%fp%"\nIs your LEDGER_FILE environment variable set correctly?") hledgerJournal else return ()+  let journalWithYears = journalFile opts []   let aggregateReportDir = outputReportDir opts ["all"]-  aggregateYears <- includeYears ch aggregateJournal-  let aggregateParams = ReportParams aggregateJournal aggregateYears aggregateReportDir+  aggregateYears <- includeYears ch journalWithYears+  let aggregateParams = ReportParams { ledgerFile = hledgerJournal+                                     , reportYears = aggregateYears+                                     , outputDir = aggregateReportDir}   let aggregateOnlyReports = reportActions opts ch [transferBalance] aggregateParams   ownerParams <- ownerParameters opts ch owners   let ownerWithAggregateParams = (if length owners > 1 then [aggregateParams] else []) ++ ownerParams@@ -112,7 +119,7 @@       return $ Left outputFile  journalFile :: RuntimeOptions -> [FilePath] -> FilePath-journalFile opts dirs = (foldl (</>) (baseDir opts) dirs) </> "all-years" <.> "journal"+journalFile opts dirs = (foldl (</>) (baseDir opts) ("import":dirs)) </> allYearsFileName  outputReportDir :: RuntimeOptions -> [FilePath] -> FilePath outputReportDir opts dirs = foldl (</>) (baseDir opts) ("reports":dirs)@@ -124,6 +131,6 @@  ownerParameters' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> IO ReportParams ownerParameters' opts ch owner = do-  let ownerJournal = journalFile opts ["import", owner]+  let ownerJournal = journalFile opts [owner]   years <- includeYears ch ownerJournal   return $ ReportParams ownerJournal years (outputReportDir opts [owner])

@@ -6,7 +6,8 @@ import Hledger.Flow.Types  data RuntimeOptions = RuntimeOptions { baseDir :: FilePath-                                     , runDir :: Maybe FilePath+                                     , importRunDir :: FilePath+                                     , useRunDir :: Bool                                      , hfVersion :: Text                                      , hledgerInfo :: HledgerInfo                                      , sysInfo :: SystemInfo@@ -17,10 +18,10 @@   deriving (Show)  instance HasVerbosity RuntimeOptions where-  verbose (RuntimeOptions _ _ _ _ _ v _ _) = v+  verbose (RuntimeOptions _ _ _ _ _ _ v _ _) = v  instance HasSequential RuntimeOptions where-  sequential (RuntimeOptions _ _ _ _ _ _ _ sq) = sq+  sequential (RuntimeOptions _ _ _ _ _ _ _ _ sq) = sq  instance HasBaseDir RuntimeOptions where-  baseDir (RuntimeOptions bd _ _ _ _ _ _ _) = bd+  baseDir (RuntimeOptions bd _ _ _ _ _ _ _ _) = bd

@@ -30,18 +30,18 @@          ch <- liftIO newTChanIO -        extraOpening1 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] [] []+        extraOpening1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] [] []         liftIO $ assertEqual "The opening journal should not be included when it is not on disk" expectedEmpty extraOpening1 -        extraClosing1 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] [] []+        extraClosing1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] [] []         liftIO $ assertEqual "The closing journal should not be included when it is not on disk" expectedEmpty extraClosing1          touchAll [opening, closing] -        extraOpening2 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] [] []+        extraOpening2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] [] []         liftIO $ assertEqual "The opening journal should be included when it is on disk" [(accountInclude, [opening])] extraOpening2 -        extraClosing2 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] [] []+        extraClosing2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] [] []         liftIO $ assertEqual "The closing journal should be included when it is on disk" [(accountInclude, [closing])] extraClosing2      )) @@ -60,13 +60,13 @@          ch <- liftIO newTChanIO -        price1 <- extraIncludesForFile (defaultOpts tmpdir) ch includeFile [] [] ["prices.journal"]+        price1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch includeFile [] [] ["prices.journal"]         liftIO $ assertEqual "The price file should not be included when it is not on disk" expectedEmpty price1          touchAll [tmpdir </> priceFile]         let expectedPricePath = tmpdir </> "import" </> ".." </> priceFile -        price2 <- extraIncludesForFile (defaultOpts tmpdir) ch includeFile [] [] ["prices.journal"]+        price2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch includeFile [] [] ["prices.journal"]         liftIO $ assertEqual "The price file should be included when it is on disk" [(includeFile, [expectedPricePath])] price2      )) @@ -85,7 +85,7 @@                                                     ownerDir </> "bank2" </> "2019-include.journal"]          ch <- liftIO newTChanIO-        fileMap <- toIncludeFiles (defaultOpts tmpdir) ch includeMap+        fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdir) ch includeMap         let expectedText = includePreamble <> "\n"               <> "!include _manual_/2019/pre-import.journal\n"               <> "!include bank1/2019-include.journal\n"@@ -110,7 +110,7 @@         let includeMap = Map.singleton includeFile [accountDir </> "3-journal" </> "2019" </> "2019-01-30.journal"]          ch <- liftIO newTChanIO-        fileMap <- toIncludeFiles (defaultOpts tmpdir) ch includeMap+        fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdir) ch includeMap         let expectedText = includePreamble <> "\n"               <> "!include 2019-opening.journal\n"               <> "!include 3-journal/2019/2019-01-30.journal\n"@@ -134,7 +134,7 @@         let includeMap = Map.singleton includeFile [importDir </> "john" </> "2020-include.journal"]          ch <- liftIO newTChanIO-        fileMap <- toIncludeFiles (defaultOpts tmpdir) ch includeMap+        fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdir) ch includeMap         let expectedText = includePreamble <> "\n"               <> "!include _manual_/2020/pre-import.journal\n"               <> "!include john/2020-include.journal\n"@@ -175,7 +175,7 @@                                 john1, john2, john3, john4, john5, john6, john7, john8]          ch <- liftIO newTChanIO-        reportedAsWritten <- single $ groupAndWriteIncludeFiles (defaultOpts tmpdir) ch importedJournals+        reportedAsWritten <- liftIO $ groupAndWriteIncludeFiles (defaultOpts tmpdir) ch importedJournals         liftIO $ assertEqual "groupAndWriteIncludeFiles should return which files it wrote" expectedIncludes reportedAsWritten          let allYears = [tmpdir </> "import/jane/bogartbank/checking/all-years.journal",

@@ -12,6 +12,9 @@ import TestHelpers import Hledger.Flow.Common +import Data.Either+import qualified Data.Text as T+ groupedJaneBogart :: Map.Map FilePath [FilePath] groupedJaneBogart = [   ("./import/jane/bogartbank/checking/2018-include.journal",@@ -350,24 +353,31 @@     assertEqual "groupIncludeFiles 5" expectedGroup5 group5   ) -testRelativeToBase :: Test-testRelativeToBase = TestCase (+testIncludeYears :: Test+testIncludeYears = TestCase (   do-    let expected = "file1.journal"-    let relativeWithTrailingSlash = relativeToBase' "./base/dir/" "./base/dir/file1.journal"-    assertEqual "relative base dir with trailing slash" expected relativeWithTrailingSlash+    let txterr = "Some text without years"+    let expectederr = ["Unable to extract years from the following text:", txterr, "Errors:"]+    let actualerr = (init . head) $ map (T.lines) $ lefts [includeYears' txterr] :: [Text]+    assertEqual "Get a list of years from an include file - error case" expectederr actualerr -    let relativeNoTrailingSlash = relativeToBase' "./base/dir" "./base/dir/file1.journal"-    assertEqual "relative base dir without a trailing slash" expected relativeNoTrailingSlash+    let txt1 = "### Generated by hledger-flow - DO NOT EDIT ###\n\n" <>+          "!include import/2014-include.journal\n" <>+          "!include import/2015-include.journal\n" <>+          "!include import/2016-include.journal\n" <>+          "!include import/2017-include.journal\n" <>+          "!include import/2018-include.journal\n" <>+          "!include import/2019-include.journal" -    let absoluteWithTrailingSlash = relativeToBase' "/base/dir/" "/base/dir/file1.journal"-    assertEqual "absolute base dir with trailing slash" expected absoluteWithTrailingSlash+    let expected1 = Right [2014..2019]+    let actual1 = includeYears' txt1+    assertEqual "Get a list of years from an include file - success case 1" expected1 actual1 -    let absoluteNoTrailingSlash = relativeToBase' "/base/dir" "/base/dir/file1.journal"-    assertEqual "absolute base dir without a trailing slash" expected absoluteNoTrailingSlash+    let txt2 = "!include 2019-include.journal" -    let mismatch = relativeToBase' "/base/dir" "/unrelated/dir/file1.journal"-    assertEqual "A basedir with no shared prefix should return the supplied file unchanged" "/unrelated/dir/file1.journal" mismatch+    let expected2 = Right [2019]+    let actual2 = includeYears' txt2+    assertEqual "Get a list of years from an include file - success case 2" expected2 actual2   )  testToIncludeLine :: Test@@ -409,9 +419,9 @@            "!include import/john/bogartbank/savings/3-journal/2018/2018-01-30.journal\n" <>            "!include import/john/bogartbank/savings/3-journal/2018/2018-02-30.journal\n")] -    ch <- liftIO newTChanIO-    txt <- single $ toIncludeFiles (defaultOpts ".") ch groupedJohnBogart+    ch <- newTChanIO+    txt <- toIncludeFiles (defaultOpts ".") ch groupedJohnBogart     assertEqual "Convert a grouped map of paths, to a map with text contents for each file" expected txt)  tests :: Test-tests = TestList [testYearsIncludeMap, testYearsIncludeGrouping, testGroupIncludeFilesTinySet, testGroupIncludeFilesSmallSet, testGroupIncludeFiles, testRelativeToBase, testToIncludeLine, testToIncludeFiles]+tests = TestList [testYearsIncludeMap, testYearsIncludeGrouping, testGroupIncludeFilesTinySet, testGroupIncludeFilesSmallSet, testGroupIncludeFiles, testIncludeYears, testToIncludeLine, testToIncludeFiles]

@@ -16,7 +16,9 @@ testHiddenFiles = TestCase (   sh (       do-        tmpdir <- using (mktempdir "." "hlflow")+        let tmpbase = "." </> "test" </> "tmp"+        mktree tmpbase+        tmpdir <- using (mktempdir tmpbase "hlflowtest")         let tmpJournals = map (tmpdir </>) journalFiles :: [FilePath]         let tmpExtras = map (tmpdir </>) extraFiles :: [FilePath]         let tmpHidden = map (tmpdir </>) hiddenFiles :: [FilePath]@@ -28,35 +30,78 @@      )   ) -assertSubDirsForDetermineBaseDir :: FilePath -> [FilePath] -> IO ()-assertSubDirsForDetermineBaseDir expectedBaseDir importDirs = do-  _ <- sequence $ map (assertDetermineBaseDir expectedBaseDir) importDirs+assertSubDirsForDetermineBaseDir :: FilePath -> FilePath -> [FilePath] -> IO ()+assertSubDirsForDetermineBaseDir initialPwd expectedBaseDir importDirs = do+  _ <- sequence $ map (assertDetermineBaseDir initialPwd expectedBaseDir) importDirs   return () -assertDetermineBaseDir :: FilePath -> FilePath -> IO ()-assertDetermineBaseDir expectedBaseDir subDir = do-  initialPwd <- pwd-  bd1 <- determineBaseDir $ Just subDir+assertDetermineBaseDir :: FilePath -> FilePath -> FilePath -> IO ()+assertDetermineBaseDir initialPwd expectedBaseDir subDir = do+  cd initialPwd+  (bd1, runDir1) <- determineBaseDir $ Just subDir+  assertFindTestFileUsingRundir bd1 runDir1+   cd subDir-  bd2 <- determineBaseDir Nothing-  bd3 <- determineBaseDir $ Just "."+  (bd2, runDir2) <- determineBaseDir Nothing+  assertFindTestFileUsingRundir bd2 runDir2++  (bd3, runDir3) <- determineBaseDir $ Just "."+  assertFindTestFileUsingRundir bd3 runDir3++  (bd4, runDir4) <- determineBaseDir $ Just "./"+  assertFindTestFileUsingRundir bd4 runDir4+   cd initialPwd   let msg = format ("determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - "%fp) subDir-  _ <- sequence $ map (assertEqual (T.unpack msg) expectedBaseDir) [bd1, bd2, bd3]+  _ <- sequence $ map (assertEqual (T.unpack msg) expectedBaseDir) [bd1, bd2, bd3, bd4]   return () +assertFindTestFileUsingRundir :: FilePath -> FilePath -> IO ()+assertFindTestFileUsingRundir baseDir runDir = do+  let absRunDir = baseDir </> runDir+  let dirTestMsg = format ("Directories should end with a slash: "%fp)+  _ <- sequence $ map (\dir -> assertEqual (T.unpack $ dirTestMsg dir) (forceTrailingSlash dir) dir) [baseDir, runDir, absRunDir]++  found <- single $ fmap head $ shellToList $ find (has "test-file.txt") absRunDir+  fileContents <- readTextFile found+  assertEqual "We should find our test file by searching from the returned runDir" (format ("The expected base dir is "%fp) baseDir) fileContents++assertCurrentDirVariations :: FilePath -> FilePath -> IO ()+assertCurrentDirVariations absoluteTempDir bdRelativeToTempDir = do+  let absBaseDirNoTrailingSlash = absoluteTempDir </> bdRelativeToTempDir+  let absBaseDirWithTrailingSlash = forceTrailingSlash absBaseDirNoTrailingSlash+  assertEqual "Test the test: with and without slashes should really be that" '/' (T.last $ format fp absBaseDirWithTrailingSlash)+  assertBool "Test the test: with and without slashes should really be that" ('/' /= (T.last $ format fp absBaseDirNoTrailingSlash))++  cd absBaseDirNoTrailingSlash+  (bd1, runDir1) <- liftIO $ determineBaseDir Nothing+  (bd2, runDir2) <- liftIO $ determineBaseDir $ Just "."+  (bd3, runDir3) <- liftIO $ determineBaseDir $ Just "./"+  (bd4, runDir4) <- liftIO $ determineBaseDir $ Just absBaseDirNoTrailingSlash+  (bd5, runDir5) <- liftIO $ determineBaseDir $ Just absBaseDirWithTrailingSlash++  let msg label dir = format ("When pwd is the base dir, determineBaseDir returns the same "%s%", regardless of the input variation. "%s%":  "%fp) label label dir+  _ <- sequence $ map (\dir -> assertEqual (T.unpack $ msg "baseDir" dir) (forceTrailingSlash dir) dir) [bd1, bd2, bd3, bd4,bd5]+  _ <- sequence $ map (\dir -> assertEqual (T.unpack $ msg "runDir" dir) "./" dir) [runDir1, runDir2, runDir3, runDir4, runDir5]+  -- _ <- sequence $ map (\dir -> assertEqual (T.unpack $ msg "runDir" dir) "./" dir) [runDir2, runDir3, runDir4, runDir5]+  return ()+ testDetermineBaseDir :: Test testDetermineBaseDir = TestCase (   sh (       do-        error1 <- liftIO $ determineBaseDir'' "/path/to/dir" "/path/to/dir"-        liftIO $ assertEqual "determineBaseDir produces an error message when given a non-existant dir" (Left $ errorMessageBaseDir "/path/to/dir") error1-        tmpdir <- using (mktempdir "." "hlflow")+        error1 <- liftIO $ determineBaseDirFromAbsoluteStartDir "/path/to/dir"+        liftIO $ assertEqual "determineBaseDir produces an error message when given a non-existant dir" (Left "The provided directory does not exist: /path/to/dir") error1 -        let unrelatedDir = collapse $ tmpdir </> "unrelated"+        initialPwd <- fmap forceTrailingSlash pwd+        let tmpbase = initialPwd </> "test" </> "tmp"+        mktree tmpbase+        absoluteTempDir <- fmap forceTrailingSlash $ using (mktempdir tmpbase "hlflowtest")++        let unrelatedDir = absoluteTempDir </> "unrelated"         mkdir unrelatedDir -        bdUnrelated <- liftIO $ determineBaseDir'' unrelatedDir unrelatedDir+        bdUnrelated <- liftIO $ determineBaseDirFromAbsoluteStartDir unrelatedDir         liftIO $ assertEqual "determineBaseDir produces an error message when it cannot find a baseDir" (Left $ errorMessageBaseDir unrelatedDir) bdUnrelated          let baseDir = "bd1"@@ -68,20 +113,27 @@         let yearDir = inDir </> "2019"         let subDirs = [yearDir, inDir, accDir, bankDir, ownerDir, importDir, baseDir] -        mktree $ tmpdir </> yearDir+        mktree $ absoluteTempDir </> yearDir -        let subDirsRelativeToTop = map (tmpdir </>) subDirs+        let fictionalDir = absoluteTempDir </> ownerDir </> "fictionalDir"+        errorSub <- liftIO $ determineBaseDirFromAbsoluteStartDir fictionalDir+        liftIO $ assertEqual "determineBaseDir produces an error message when given a non-existant subdir of a valid basedir" (Left $ format ("The provided directory does not exist: "%fp) fictionalDir) errorSub -        currentDir <- pwd-        let absoluteTempDir = forceTrailingSlash $ collapse $ currentDir </> tmpdir+        let relativeTempDir = foldl1 mappend (dropWhile (\el -> el `elem` (splitDirectories initialPwd)) (splitDirectories absoluteTempDir))+++        let subDirsRelativeToTop = map (relativeTempDir </>) subDirs         let absoluteSubDirs = map (absoluteTempDir </>) subDirs          let absoluteBaseDir = forceTrailingSlash $ absoluteTempDir </> baseDir-        liftIO $ assertSubDirsForDetermineBaseDir absoluteBaseDir absoluteSubDirs-        liftIO $ assertSubDirsForDetermineBaseDir absoluteBaseDir subDirsRelativeToTop -        cd absoluteTempDir-        liftIO $ assertSubDirsForDetermineBaseDir absoluteBaseDir subDirs+        liftIO $ assertCurrentDirVariations absoluteTempDir baseDir++        liftIO $ writeTextFile (absoluteTempDir </> yearDir </> "test-file.txt") $ format ("The expected base dir is "%fp) absoluteBaseDir++        liftIO $ assertSubDirsForDetermineBaseDir absoluteTempDir absoluteBaseDir subDirs+        liftIO $ assertSubDirsForDetermineBaseDir absoluteTempDir absoluteBaseDir absoluteSubDirs+        liftIO $ assertSubDirsForDetermineBaseDir initialPwd absoluteBaseDir subDirsRelativeToTop      )   ) @@ -89,7 +141,9 @@ testFilterPaths = TestCase (   sh (       do-        tmpdir <- using (mktempdir "." "hlflow")+        let tmpbase = "." </> "test" </> "tmp"+        mktree tmpbase+        tmpdir <- using (mktempdir tmpbase "hlflowtest")         let tmpJournals = map (tmpdir </>) journalFiles :: [FilePath]         let tmpExtras = map (tmpdir </>) extraFiles :: [FilePath]         let tmpHidden = map (tmpdir </>) hiddenFiles :: [FilePath]

@@ -4,14 +4,10 @@ module Common.Unit where  import Test.HUnit-import Turtle import Prelude hiding (FilePath)  import Hledger.Flow.Common -import Data.Either-import qualified Data.Text as T- testShowCmdArgs :: Test testShowCmdArgs = TestCase (   do@@ -20,31 +16,33 @@     let actual = showCmdArgs opts     assertEqual "Convert command-line arguments to text" expected actual) -testIncludeYears :: Test-testIncludeYears = TestCase (+testRelativeToBase :: Test+testRelativeToBase = TestCase (   do-    let txterr = "Some text without years"-    let expectederr = ["Unable to extract years from the following text:", txterr, "Errors:"]-    let actualerr = (init . head) $ map (T.lines) $ lefts [includeYears' txterr] :: [Text]-    assertEqual "Get a list of years from an include file - error case" expectederr actualerr+    let expected = "file1.journal"+    let relativeWithTrailingSlash = relativeToBase' "./base/dir/" "./base/dir/file1.journal"+    assertEqual "relative base dir with trailing slash" expected relativeWithTrailingSlash -    let txt1 = "### Generated by hledger-flow - DO NOT EDIT ###\n\n" <>-          "!include import/2014-include.journal\n" <>-          "!include import/2015-include.journal\n" <>-          "!include import/2016-include.journal\n" <>-          "!include import/2017-include.journal\n" <>-          "!include import/2018-include.journal\n" <>-          "!include import/2019-include.journal"+    let relativeNoTrailingSlash = relativeToBase' "./base/dir" "./base/dir/file1.journal"+    assertEqual "relative base dir without a trailing slash" expected relativeNoTrailingSlash -    let expected1 = Right [2014..2019]-    let actual1 = includeYears' txt1-    assertEqual "Get a list of years from an include file - success case 1" expected1 actual1+    let absoluteWithTrailingSlash = relativeToBase' "/base/dir/" "/base/dir/file1.journal"+    assertEqual "absolute base dir with trailing slash" expected absoluteWithTrailingSlash -    let txt2 = "!include 2019-include.journal"+    let absoluteNoTrailingSlash = relativeToBase' "/base/dir" "/base/dir/file1.journal"+    assertEqual "absolute base dir without a trailing slash" expected absoluteNoTrailingSlash -    let expected2 = Right [2019]-    let actual2 = includeYears' txt2-    assertEqual "Get a list of years from an include file - success case 2" expected2 actual2+    let absoluteTwiceNoTrailingSlash = relativeToBase' "/base/dir" "/base/dir"+    assertEqual "absolute base dir without a trailing slash supplied twice" "./" absoluteTwiceNoTrailingSlash++    let absoluteTwiceWithTrailingSlash = relativeToBase' "/base/dir/" "/base/dir/"+    assertEqual "absolute base dir with a trailing slash supplied twice" "./" absoluteTwiceWithTrailingSlash++    let absoluteTwiceNoTrailingSlashOnSecondParam = relativeToBase' "/base/dir/" "/base/dir"+    assertEqual "absolute base dir supplied twice, but the second param has no slash" "./" absoluteTwiceNoTrailingSlashOnSecondParam++    let mismatch = relativeToBase' "/base/dir" "/unrelated/dir/file1.journal"+    assertEqual "A basedir with no shared prefix should return the supplied file unchanged" "/unrelated/dir/file1.journal" mismatch   )  testExtractDigits :: Test@@ -64,4 +62,4 @@   )  tests :: Test-tests = TestList [testShowCmdArgs, testIncludeYears, testExtractDigits]+tests = TestList [testShowCmdArgs, testRelativeToBase, testExtractDigits]

@@ -59,7 +59,7 @@ defaultHlInfo = FlowTypes.HledgerInfo "/path/to/hledger" "1.2.3"  defaultOpts :: FilePath -> RuntimeOptions-defaultOpts bd = RuntimeOptions bd Nothing versionInfo' defaultHlInfo systemInfo False False False+defaultOpts bd = RuntimeOptions bd "./" True versionInfo' defaultHlInfo systemInfo False False False  toJournals :: [FilePath] -> [FilePath] toJournals = map (changePathAndExtension "3-journal" "journal")