diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,18 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.16.3 + +- Change `--new-files-only` to use modification time comparison instead of existence check. + Previously, this flag skipped regeneration only if output files existed. + Now it compares source and target modification times, allowing automatic + reprocessing when source files are updated. Note: changes to rules files + or construct/preprocess scripts are not tracked. + +## 0.16.2 + + - Add a Github Actions workflow, contributed by [Udit Desai](https://github.com/apauley/hledger-flow/issues?q=author%3Adesaiuditd) + - Update Stack resolver to LTS Haskell 24.26 (ghc-9.10.3) + ## 0.16.1 - Fix documentation URL: https://github.com/apauley/hledger-flow/tree/master/docs#feature-reference diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -134,7 +134,7 @@ subcommandParserImport = ImportParams <$> optional (Turtle.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.") <*> optional (option str (long "start-year" <> metavar "YEAR" <> help "Import only from the specified year and onwards, ignoring previous years. By default all available years are imported. Valid values include a 4-digit year or 'current' for the current year")) - <*> switch (long "new-files-only" <> help "Don't regenerate transaction files if they are already present. This applies to hledger journal files as well as files produced by the preprocess and construct scripts.") + <*> switch (long "new-files-only" <> help "Skip regenerating output files that are at least as new as their source. This applies to preprocessed files and hledger journal files.") subcommandParserReport :: Parser ReportParams subcommandParserReport = ReportParams diff --git a/hledger-flow.cabal b/hledger-flow.cabal --- a/hledger-flow.cabal +++ b/hledger-flow.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 9711cc7907045ee1194c92bdb910d265677ae1a32a1395e49da6dbd1099c92ca +-- hash: 1b63379a0d0b0c58f45cec49ae2eae3f1f4408ac97b070977ba5c1bce02f8f05 name: hledger-flow -version: 0.16.1 +version: 0.16.3 synopsis: An hledger workflow focusing on automated statement import and classification. description: Please see the README on GitHub at category: Finance, Console @@ -50,17 +50,17 @@ ghc-options: -Wall build-depends: base >=4.7 && <5 - , containers - , exceptions - , filepath - , foldl - , gitrev - , path - , path-io - , stm - , text - , time - , turtle + , containers ==0.7.* + , exceptions >=0.10.9 && <0.11 + , filepath >=1.5.4.0 && <1.6 + , foldl >=1.4.18 && <1.5 + , gitrev >=1.3.1 && <1.4 + , path >=0.9.6 && <0.10 + , path-io >=1.8.2 && <1.9 + , stm >=2.5.3.1 && <2.6 + , text >=2.1.3 && <2.2 + , time >=1.12.2 && <1.13 + , turtle >=1.6.2 && <1.7 default-language: Haskell2010 executable hledger-flow @@ -75,10 +75,10 @@ build-depends: base >=4.7 && <5 , hledger-flow - , optparse-applicative - , path - , text - , turtle + , optparse-applicative >=0.18.1.0 && <0.19 + , path >=0.9.6 && <0.10 + , text >=2.1.3 && <2.2 + , turtle >=1.6.2 && <1.7 default-language: Haskell2010 test-suite hledger-flow-test @@ -92,6 +92,7 @@ CSVImport.ImportHelperTurtleTests CSVImport.Integration CSVImport.Unit + ImportHelpers.Integration PathHelpers.Unit TestHelpers TestHelpersTurtle @@ -102,12 +103,14 @@ build-depends: HUnit , base >=4.7 && <5 - , containers - , foldl + , containers ==0.7.* + , directory + , foldl >=1.4.18 && <1.5 , hledger-flow - , path - , path-io - , stm - , text - , turtle + , path >=0.9.6 && <0.10 + , path-io >=1.8.2 && <1.9 + , stm >=2.5.3.1 && <2.6 + , text >=2.1.3 && <2.2 + , time >=1.12.2 && <1.13 + , turtle >=1.6.2 && <1.7 default-language: Haskell2010 diff --git a/src/Hledger/Flow/Common.hs b/src/Hledger/Flow/Common.hs --- a/src/Hledger/Flow/Common.hs +++ b/src/Hledger/Flow/Common.hs @@ -1,14 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Hledger.Flow.Common where import Control.Concurrent.STM +import Control.Exception (IOException, try) import qualified Control.Foldl as Fold import Data.Char (isDigit) import Data.Either import Data.Function (on) import qualified Data.List as List (groupBy, null, sortBy) +import Data.Maybe (mapMaybe) import qualified Data.Map.Strict as Map import Data.Ord (comparing) import qualified Data.Text as T @@ -193,9 +196,31 @@ else logVerbose opts ch $ Turtle.format ("Looked for but did not find '" % Turtle.fp % "'") rel return fileExists +needsRegeneration :: TurtlePath -> TurtlePath -> IO Bool +needsRegeneration src target = do + targetExists <- Turtle.testfile target + if not targetExists + then return True + else do + -- Use try to handle race conditions where files may be modified/deleted + -- between existence check and stat. Treat any IO error as "needs regeneration". + result <- try $ do + srcStat <- Turtle.stat src + targetStat <- Turtle.stat target + let srcMtime = Turtle.modificationTime srcStat + let targetMtime = Turtle.modificationTime targetStat + return (srcMtime > targetMtime) + case result of + Right needsRegen -> return needsRegen + Left (_ :: IOException) -> return True + groupPairs' :: (Eq a, Ord a) => [(a, b)] -> [(a, [b])] groupPairs' = - map (\ll -> (fst . head $ ll, map snd ll)) + mapMaybe + ( \ll -> case ll of + [] -> Nothing + ((k, _) : _) -> Just (k, map snd ll) + ) . List.groupBy ((==) `on` fst) . List.sortBy (comparing fst) diff --git a/src/Hledger/Flow/Import/CSVImport.hs b/src/Hledger/Flow/Import/CSVImport.hs --- a/src/Hledger/Flow/Import/CSVImport.hs +++ b/src/Hledger/Flow/Import/CSVImport.hs @@ -92,7 +92,7 @@ let journalOut = changePathAndExtension "3-journal/" "journal" csvFile shouldImport <- if onlyNewFiles opts && not preprocessHappened - then not <$> verboseTestFile opts ch journalOut + then needsRegeneration csvFile journalOut else return True importFun <- @@ -118,15 +118,17 @@ scriptExists <- verboseTestFile opts ch script targetExists <- verboseTestFile opts ch csvOut shouldProceed <- - if onlyNewFiles opts - then return $ scriptExists && not targetExists + 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 out <- preprocess opts ch script bank account owner src csvOut return (out, True) else do - _ <- logNewFileSkip opts ch "preprocess" csvOut if targetExists then return (csvOut, False) else return (src, False) @@ -139,7 +141,7 @@ Turtle.format ( "Skipping " % Turtle.s - % " - only creating new files and this output file already exists: '" + % " - output file is at least as new as source: '" % Turtle.fp % "'" ) diff --git a/src/Hledger/Flow/PathHelpers.hs b/src/Hledger/Flow/PathHelpers.hs --- a/src/Hledger/Flow/PathHelpers.hs +++ b/src/Hledger/Flow/PathHelpers.hs @@ -87,4 +87,8 @@ else return [] excludeHiddenFiles :: [AbsFile] -> [AbsFile] -excludeHiddenFiles = filter (\f -> head (Path.toFilePath (Path.filename f)) /= '.') +excludeHiddenFiles = filter (not . isHiddenFile) + where + isHiddenFile f = case Path.toFilePath (Path.filename f) of + '.':_ -> True + _ -> False diff --git a/test/BaseDir/Integration.hs b/test/BaseDir/Integration.hs --- a/test/BaseDir/Integration.hs +++ b/test/BaseDir/Integration.hs @@ -7,7 +7,7 @@ import Control.Exception (try) import qualified Data.Text as T import qualified Data.Text.IO as T -import Hledger.Flow.BaseDir (determineBaseDir) +import Hledger.Flow.BaseDir (determineBaseDir, effectiveRunDir) import Hledger.Flow.Common import Hledger.Flow.PathHelpers import Hledger.Flow.Types (BaseDir, RunDir) @@ -44,24 +44,25 @@ assertFindTestFileUsingRundir :: BaseDir -> RunDir -> IO () assertFindTestFileUsingRundir baseDir runDir = do let absRunDir = baseDir runDir - - found <- Turtle.single $ fmap head $ shellToList $ Turtle.find (Turtle.has "test-file.txt") $ pathToTurtle absRunDir - fileContents <- T.readFile found - assertEqual "We should find our test file by searching from the returned runDir" (T.pack $ "The expected base dir is " ++ show baseDir) fileContents + foundFiles <- Turtle.single $ shellToList $ Turtle.find (Turtle.has "test-file.txt") $ pathToTurtle absRunDir + case foundFiles of + (found : _) -> do + fileContents <- T.readFile found + assertEqual "We should find our test file by searching from the returned runDir" (T.pack $ "The expected base dir is " ++ show baseDir) fileContents + [] -> assertFailure "Expected to find test-file.txt but search returned no results" assertCurrentDirVariations :: AbsDir -> RelDir -> IO () assertCurrentDirVariations absoluteTempDir bdRelativeToTempDir = do let absBaseDir = absoluteTempDir bdRelativeToTempDir - - setCurrentDir absBaseDir - (bd1, runDir1) <- determineBaseDir Nothing - (bd2, runDir2) <- determineBaseDir $ Just "." - (bd3, runDir3) <- determineBaseDir $ Just "./" - (bd4, runDir4) <- determineBaseDir $ Just $ pathToTurtle absBaseDir + withCurrentDir absBaseDir $ do + (bd1, runDir1) <- determineBaseDir Nothing + (bd2, runDir2) <- determineBaseDir $ Just "." + (bd3, runDir3) <- determineBaseDir $ Just "./" + (bd4, runDir4) <- determineBaseDir $ Just $ pathToTurtle absBaseDir - let msg label dir = "When pwd is the base dir, determineBaseDir returns the same " ++ label ++ ", regardless of the input variation. " ++ show dir - sequence_ $ map (\dir -> assertEqual (msg "baseDir" dir) absBaseDir dir) [bd1, bd2, bd3, bd4] - sequence_ $ map (\dir -> assertEqual (msg "runDir" dir) [reldir|.|] dir) [runDir1, runDir2, runDir3, runDir4] + let msg label dir = "When pwd is the base dir, determineBaseDir returns the same " ++ label ++ ", regardless of the input variation. " ++ show dir + sequence_ $ map (\dir -> assertEqual (msg "baseDir" dir) absBaseDir dir) [bd1, bd2, bd3, bd4] + sequence_ $ map (\dir -> assertEqual (msg "runDir" dir) [reldir|.|] dir) [runDir1, runDir2, runDir3, runDir4] testBaseDirWithTempDir :: AbsDir -> AbsDir -> IO () testBaseDirWithTempDir initialPwd absoluteTempDir = do @@ -148,5 +149,20 @@ withTempDir tmpbase "hlflowtest" $ testBaseDirWithTempDir initialPwd ) +testEffectiveRunDir :: Test +testEffectiveRunDir = + TestCase + ( do + let base = [absdir|/tmp/hlflow-base|] + let expectedBaseImport = base [reldir|import|] + assertEqual "A runDir of '.' should map to base/import" expectedBaseImport (effectiveRunDir base [reldir|.|]) + + let runImport = [reldir|import|] + assertEqual "A runDir under base should be preserved" (base runImport) (effectiveRunDir base runImport) + + let runOwner = [reldir|import/john|] + assertEqual "A nested runDir should be preserved" (base runOwner) (effectiveRunDir base runOwner) + ) + tests :: Test -tests = TestList [testDetermineBaseDir, testRunDirs] +tests = TestList [testDetermineBaseDir, testRunDirs, testEffectiveRunDir] diff --git a/test/CSVImport/ImportHelperTurtleTests.hs b/test/CSVImport/ImportHelperTurtleTests.hs --- a/test/CSVImport/ImportHelperTurtleTests.hs +++ b/test/CSVImport/ImportHelperTurtleTests.hs @@ -9,8 +9,8 @@ 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.Import.ImportHelpersTurtle (allYearIncludeFiles, extractImportDirs, groupIncludeFiles, toIncludeFiles, toIncludeLine, yearsIncludeMap) +import Hledger.Flow.Import.Types (ImportDirs (..), TurtleFileBundle) import Hledger.Flow.PathHelpers (TurtlePath) import Path import Test.HUnit @@ -150,14 +150,18 @@ assertEqual "groupIncludeFiles small allYears 1" expectedAllYears1 allYears1 assertEqual "groupIncludeFiles small set 1" expected1 group1 - let journals2 = [(fst . head . Map.toList) expected1] :: [TurtlePath] + 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 - let journals3 = [(fst . head . Map.toList) expected2] :: [TurtlePath] + 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 @@ -512,7 +516,9 @@ ( 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] + let actualerr = case lefts [includeYears' txterr] of + (errTxt : _) -> (init . T.lines) errTxt + [] -> [] assertEqual "Get a list of years from an include file - error case" expectederr actualerr let txt1 = @@ -586,5 +592,65 @@ assertEqual "Convert a grouped map of paths, to a map with text contents for each file" expected txt ) +testExtractImportDirsSuccess :: Test +testExtractImportDirsSuccess = + TestCase + ( do + let file = "import/john/mybank/checking/1-in/2019/2019-01-01.csv" + case extractImportDirs file of + Left err -> assertFailure (T.unpack err) + Right dirs -> do + let expectedYear = Turtle.directory file + let expectedState = Turtle.parent expectedYear + let expectedAccount = Turtle.parent expectedState + let expectedBank = Turtle.parent expectedAccount + let expectedOwner = Turtle.parent expectedBank + let expectedImport = Turtle.parent expectedOwner + assertEqual "importDir" expectedImport (importDir dirs) + assertEqual "ownerDir" expectedOwner (ownerDir dirs) + assertEqual "bankDir" expectedBank (bankDir dirs) + assertEqual "accountDir" expectedAccount (accountDir dirs) + assertEqual "stateDir" expectedState (stateDir dirs) + assertEqual "yearDir" expectedYear (yearDir dirs) + ) + +testExtractImportDirsFailure :: Test +testExtractImportDirsFailure = + TestCase + ( do + let badFile = "import/john/mybank/checking/2019-01-01.csv" + case extractImportDirs badFile of + Left err -> + assertBool + "Error should explain expected structure" + ("expects to find input files in this structure" `T.isInfixOf` err) + Right _ -> assertFailure "Expected failure for malformed import path" + ) + +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 + ) + tests :: Test -tests = TestList [testYearsIncludeMap, testYearsIncludeGrouping, testGroupIncludeFilesTinySet, testGroupIncludeFilesSmallSet, testGroupIncludeFiles, testIncludeYears, testToIncludeLine, testToIncludeFiles] +tests = + TestList + [ testYearsIncludeMap, + testYearsIncludeGrouping, + testGroupIncludeFilesTinySet, + testGroupIncludeFilesSmallSet, + testGroupIncludeFiles, + testIncludeYears, + testToIncludeLine, + testToIncludeFiles, + testExtractImportDirsSuccess, + testExtractImportDirsFailure, + testGroupIncludeFilesFiltersNonJournal + ] diff --git a/test/CSVImport/Integration.hs b/test/CSVImport/Integration.hs --- a/test/CSVImport/Integration.hs +++ b/test/CSVImport/Integration.hs @@ -8,7 +8,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Text.IO as T import Hledger.Flow.Common -import Hledger.Flow.Import.ImportHelpersTurtle (extraIncludesForFile, groupAndWriteIncludeFiles, includePreamble, toIncludeFiles) +import Hledger.Flow.Import.ImportHelpersTurtle (extraIncludesForFile, groupAndWriteIncludeFiles, includePreamble, toIncludeFiles, writeIncludesUpTo, writeToplevelAllYearsInclude) import Hledger.Flow.PathHelpers import Test.HUnit import TestHelpers (defaultOpts) @@ -293,5 +293,80 @@ ) ) +testWriteToplevelAllYearsInclude :: Test +testWriteToplevelAllYearsInclude = + TestCase + ( sh + ( do + currentDir <- pwd + tmpdir <- using (mktempdir currentDir "hlflow") + tmpdirAbsPath <- fromTurtleAbsDir tmpdir + + written1 <- liftIO $ writeToplevelAllYearsInclude (defaultOpts tmpdirAbsPath) + let expectedFile = tmpdir "all-years.journal" + liftIO $ assertEqual "Should write the top-level all-years include file" [expectedFile] written1 + let expectedNoDirectives = + includePreamble + <> "\n" + <> "include import/all-years.journal\n" + actualNoDirectives <- liftIO $ T.readFile expectedFile + liftIO $ assertEqual "Top-level include should not reference directives when missing" expectedNoDirectives actualNoDirectives + + let directives = tmpdir "directives.journal" + touch directives + written2 <- liftIO $ writeToplevelAllYearsInclude (defaultOpts tmpdirAbsPath) + liftIO $ assertEqual "Should overwrite the top-level all-years include file" [expectedFile] written2 + let expectedWithDirectives = + includePreamble + <> "\n" + <> "include directives.journal\n" + <> "include import/all-years.journal\n" + actualWithDirectives <- liftIO $ T.readFile expectedFile + liftIO $ assertEqual "Top-level include should reference directives when present" expectedWithDirectives actualWithDirectives + ) + ) + +testWriteIncludesUpTo :: Test +testWriteIncludesUpTo = + TestCase + ( sh + ( do + currentDir <- pwd + tmpdir <- using (mktempdir currentDir "hlflow") + tmpdirAbsPath <- fromTurtleAbsDir tmpdir + + let journal = tmpdir "import/john/mybank/checking/3-journal/2019/2019-01-01.journal" + touchAll [journal] + + ch <- liftIO newTChanIO + let yearDir = Turtle.directory journal + let stateDir = Turtle.parent yearDir + let accountDir = Turtle.parent stateDir + let bankDir = Turtle.parent accountDir + let ownerDir = Turtle.parent bankDir + let stopAt = Turtle.parent ownerDir + written <- liftIO $ writeIncludesUpTo (defaultOpts tmpdirAbsPath) ch stopAt [journal] + let expectedFinal = tmpdir "import/2019-include.journal" + liftIO $ assertEqual "writeIncludesUpTo should stop at the requested directory" [expectedFinal] written + + finalContents <- liftIO $ T.readFile expectedFinal + let expectedContents = + includePreamble + <> "\n" + <> "include john/2019-include.journal\n" + liftIO $ assertEqual "Top-level year include should reference the owner include" expectedContents finalContents + ) + ) + tests :: Test -tests = TestList [testExtraIncludesForFile, testExtraIncludesPrices, testIncludesPrePost, testIncludesOpeningClosing, testIncludesPrices, testWriteIncludeFiles] +tests = + TestList + [ testExtraIncludesForFile, + testExtraIncludesPrices, + testIncludesPrePost, + testIncludesOpeningClosing, + testIncludesPrices, + testWriteIncludeFiles, + testWriteToplevelAllYearsInclude, + testWriteIncludesUpTo + ] diff --git a/test/Common/Integration.hs b/test/Common/Integration.hs --- a/test/Common/Integration.hs +++ b/test/Common/Integration.hs @@ -4,8 +4,11 @@ module Common.Integration (tests) where import qualified Data.List as List (sort) +import Data.Time.Clock (UTCTime(..), secondsToDiffTime) +import Data.Time.Calendar (fromGregorian) import Hledger.Flow.Common import Hledger.Flow.PathHelpers (TurtlePath) +import qualified System.Directory as Dir import Test.HUnit import TestHelpersTurtle import Turtle @@ -51,5 +54,74 @@ ) ) +testFirstExistingFile :: Test +testFirstExistingFile = + TestCase + ( sh + ( do + let tmpbase = "." "test" "tmp" + mktree tmpbase + tmpdir <- using (mktempdir tmpbase "hlflowtest") + let missing = tmpdir "does-not-exist.txt" + let existing1 = tmpdir "first.txt" + let existing2 = tmpdir "second.txt" + touchAll [existing1, existing2] + + found1 <- liftIO $ firstExistingFile [missing, existing1, existing2] + liftIO $ assertEqual "Should return the first existing file in the list" (Just existing1) found1 + + found2 <- liftIO $ firstExistingFile [missing] + liftIO $ assertEqual "Should return Nothing if no files exist" Nothing found2 + ) + ) + +-- Helper to set mtime on a Turtle path +setMtime :: TurtlePath -> UTCTime -> IO () +setMtime path time = Dir.setModificationTime path time + +-- Fixed timestamps for deterministic tests +olderTime :: UTCTime +olderTime = UTCTime (fromGregorian 2020 1 1) (secondsToDiffTime 0) + +newerTime :: UTCTime +newerTime = UTCTime (fromGregorian 2025 1 1) (secondsToDiffTime 0) + +testNeedsRegeneration :: Test +testNeedsRegeneration = + TestCase + ( sh + ( do + let tmpbase = "." "test" "tmp" + mktree tmpbase + tmpdir <- using (mktempdir tmpbase "hlflowtest") + let source = tmpdir "source.txt" + let target = tmpdir "target.txt" + + -- Test case 1: target doesn't exist -> returns True + touch source + result1 <- liftIO $ needsRegeneration source target + liftIO $ assertEqual "Should return True when target doesn't exist" True result1 + + -- Test case 2: target exists, source is newer -> returns True + touch target + liftIO $ setMtime target olderTime + liftIO $ setMtime source newerTime + result2 <- liftIO $ needsRegeneration source target + liftIO $ assertEqual "Should return True when source is newer than target" True result2 + + -- Test case 3: target exists, target is newer -> returns False + liftIO $ setMtime source olderTime + liftIO $ setMtime target newerTime + result3 <- liftIO $ needsRegeneration source target + liftIO $ assertEqual "Should return False when target is newer than source" False result3 + + -- Test case 4: equal mtimes -> returns False (boundary condition) + liftIO $ setMtime source olderTime + liftIO $ setMtime target olderTime + result4 <- liftIO $ needsRegeneration source target + liftIO $ assertEqual "Should return False when mtimes are equal" False result4 + ) + ) + tests :: Test -tests = TestList [testHiddenFiles, testFilterPaths] +tests = TestList [testHiddenFiles, testFilterPaths, testFirstExistingFile, testNeedsRegeneration] diff --git a/test/Common/Unit.hs b/test/Common/Unit.hs --- a/test/Common/Unit.hs +++ b/test/Common/Unit.hs @@ -5,6 +5,8 @@ import Hledger.Flow.BaseDir (relativeToBase') import Hledger.Flow.Common +import qualified Data.List as List +import qualified Data.Map.Strict as Map import Test.HUnit testShowCmdArgs :: Test @@ -64,5 +66,36 @@ 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 + ) + +testGroupValuesBy :: Test +testGroupValuesBy = + TestCase + ( do + let values = ["b2", "a1", "b1", "a2"] + let grouped = groupValuesBy (take 1) values + let normalize = Map.map List.sort + let expected = Map.fromList [("a", ["a1", "a2"]), ("b", ["b1", "b2"])] + assertEqual "Group values by key" (normalize expected) (normalize grouped) + ) + tests :: Test -tests = TestList [testShowCmdArgs, testRelativeToBase, testExtractDigits] +tests = TestList [testShowCmdArgs, testRelativeToBase, testExtractDigits, testChangePathAndExtension, testGroupValuesBy] diff --git a/test/ImportHelpers/Integration.hs b/test/ImportHelpers/Integration.hs new file mode 100644 --- /dev/null +++ b/test/ImportHelpers/Integration.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module ImportHelpers.Integration (tests) where + +import qualified Data.List as List +import qualified Data.Text.IO as T +import Hledger.Flow.Import.ImportHelpers (findInputFiles, findJournalFiles) +import Hledger.Flow.PathHelpers (AbsFile) +import Path +import Path.IO +import Test.HUnit + +touchFile :: AbsFile -> IO () +touchFile f = do + 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) + ) + +tests :: Test +tests = TestList [testFindInputFiles, testFindJournalFiles] diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -8,12 +8,22 @@ import qualified CSVImport.Unit import qualified Common.Integration import qualified Common.Unit +import qualified ImportHelpers.Integration import qualified PathHelpers.Unit import Test.HUnit import Turtle tests :: Test -tests = TestList [Common.Unit.tests, Common.Integration.tests, PathHelpers.Unit.tests, BaseDir.Integration.tests, CSVImport.Unit.tests, CSVImport.Integration.tests] +tests = + TestList + [ Common.Unit.tests, + Common.Integration.tests, + PathHelpers.Unit.tests, + BaseDir.Integration.tests, + ImportHelpers.Integration.tests, + CSVImport.Unit.tests, + CSVImport.Integration.tests + ] main :: IO Counts main = do