diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.14.1 + +- Make `--enable-future-rundir` the default, and deprecate the command-line option. To be removed in a future release. +- Ensure that the deepest rundir is the account directory, because the program doesn't generate include files correctly in directories below the account level. + ## 0.14.0 - Add a new performance-related command-line option to import: `--new-files-only`. [PR #89](https://github.com/apauley/hledger-flow/pull/89) diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -4,7 +4,7 @@ module Main where import Path -import qualified Turtle as Turtle hiding (switch) +import qualified Turtle hiding (switch) import Prelude hiding (putStrLn) import Options.Applicative @@ -16,6 +16,9 @@ import Hledger.Flow.Reports import Hledger.Flow.CSVImport +import Control.Monad (when) +import qualified Data.Text.IO as T + data ImportParams = ImportParams { maybeImportBaseDir :: Maybe TurtlePath , importUseRunDir :: Bool , onlyNewFiles :: Bool @@ -43,11 +46,12 @@ toRuntimeOptionsImport :: MainParams -> ImportParams -> IO RT.RuntimeOptions toRuntimeOptionsImport mainParams' subParams' = do let maybeBD = maybeImportBaseDir subParams' :: Maybe TurtlePath + Control.Monad.when (importUseRunDir subParams') $ do + T.putStrLn "The enable-future-rundir option is now the default, no need to specify it. This option is currently being ignored and will be removed in future." (bd, runDir) <- determineBaseDir maybeBD hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams' return RT.RuntimeOptions { RT.baseDir = bd , RT.importRunDir = runDir - , RT.useRunDir = importUseRunDir subParams' , RT.onlyNewFiles = onlyNewFiles subParams' , RT.hfVersion = versionInfo' , RT.hledgerInfo = hli @@ -63,7 +67,6 @@ hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams' return RT.RuntimeOptions { RT.baseDir = bd , RT.importRunDir = [reldir|.|] - , RT.useRunDir = False , RT.onlyNewFiles = False , RT.hfVersion = versionInfo' , RT.hledgerInfo = hli @@ -90,7 +93,7 @@ subcommandParserImport :: Parser ImportParams 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. 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") + <*> switch (long "enable-future-rundir" <> help "This switch is currently being ignored, since the behaviour it previously enabled is now the default. It will be removed in future.") <*> 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.") subcommandParserReport :: Parser 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: 7b720ae822cc4e9d6e1e1b3e96ab162130e20c432bfd91e151bd2355f271ac54 +-- hash: a351ed4904c5177d5fa526e91057902c42ef97c4bc7814624f684725f3f17abd name: hledger-flow -version: 0.14.0.0 +version: 0.14.1.0 synopsis: An hledger workflow focusing on automated statement import and classification. description: Please see the README on GitHub at category: Finance, Console @@ -15,7 +15,7 @@ bug-reports: https://github.com/apauley/hledger-flow/issues author: Andreas Pauley maintainer: Andreas Pauley -copyright: 2018 Andreas Pauley +copyright: 2020 Andreas Pauley license: GPL-3 license-file: LICENSE build-type: Simple @@ -82,6 +82,7 @@ Common.Unit CSVImport.Integration CSVImport.Unit + PathHelpers.Unit TestHelpers Paths_hledger_flow hs-source-dirs: diff --git a/src/Hledger/Flow/BaseDir.hs b/src/Hledger/Flow/BaseDir.hs --- a/src/Hledger/Flow/BaseDir.hs +++ b/src/Hledger/Flow/BaseDir.hs @@ -1,7 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -module Hledger.Flow.BaseDir where +module Hledger.Flow.BaseDir ( + determineBaseDir + , relativeToBase + , relativeToBase' + , turtleBaseDir + , effectiveRunDir +) where import Path import Path.IO @@ -12,9 +18,11 @@ import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.IO.Class (MonadIO) - +import Control.Monad (when) -import qualified Turtle as Turtle (stripPrefix) +import qualified Turtle (liftIO, repr, stripPrefix) +import qualified Data.Text as T +import qualified Data.Text.IO as T determineBaseDir :: Maybe TurtlePath -> IO (BaseDir, RunDir) determineBaseDir suppliedDir = do @@ -32,14 +40,34 @@ determineBaseDirFromStartDir' :: (MonadIO m, MonadThrow m) => AbsDir -> AbsDir -> m (BaseDir, RunDir) determineBaseDirFromStartDir' startDir possibleBaseDir = do - _ <- if (parent possibleBaseDir == possibleBaseDir) then throwM (MissingBaseDir startDir) else return () + Control.Monad.when (parent possibleBaseDir == possibleBaseDir) $ throwM (MissingBaseDir startDir) foundBaseDir <- doesDirExist $ possibleBaseDir [reldir|import|] if foundBaseDir then do - runDir <- makeRelative possibleBaseDir startDir + runDir <- limitRunDir possibleBaseDir startDir return (possibleBaseDir, runDir) else determineBaseDirFromStartDir' startDir $ parent possibleBaseDir +-- | We have unexpected behaviour when the runDir is deeper than the account directory, +-- e.g. "1-in" or the year directory. Specifically, include files are generated incorrectly +-- and some journals are written entirely outside of the baseDir. +-- limitRunDir can possibly removed if the above is fixed. +limitRunDir :: (MonadIO m, MonadThrow m) => BaseDir -> AbsDir -> m RunDir +limitRunDir bd absRunDir = do + rel <- makeRelative bd absRunDir + let runDirDepth = pathSize rel + let fun = composeN (runDirDepth - 4) parent + let newRunDir = fun rel + when (runDirDepth > 4) $ do + let msg = T.pack $ "Changing runDir from " ++ Turtle.repr rel ++ " to " ++ Turtle.repr newRunDir :: T.Text + Turtle.liftIO $ T.putStrLn msg + return newRunDir + +composeN :: Int -> (a -> a) -> (a -> a) +composeN n f | n < 1 = id + | n == 1 = f + | otherwise = composeN (n-1) (f . f) + relativeToBase :: HasBaseDir o => o -> TurtlePath -> TurtlePath relativeToBase opts = relativeToBase' $ pathToTurtle (baseDir opts) @@ -50,10 +78,8 @@ turtleBaseDir :: HasBaseDir o => o -> TurtlePath turtleBaseDir opts = pathToTurtle $ baseDir opts -effectiveRunDir :: BaseDir -> RunDir -> Bool -> AbsDir -effectiveRunDir bd rd useRunDir = do +effectiveRunDir :: BaseDir -> RunDir -> AbsDir +effectiveRunDir bd rd = do let baseImportDir = bd [Path.reldir|import|] let absRunDir = bd rd - if useRunDir - then if absRunDir == bd then baseImportDir else absRunDir - else baseImportDir + if absRunDir == bd then baseImportDir else absRunDir diff --git a/src/Hledger/Flow/CSVImport.hs b/src/Hledger/Flow/CSVImport.hs --- a/src/Hledger/Flow/CSVImport.hs +++ b/src/Hledger/Flow/CSVImport.hs @@ -4,7 +4,7 @@ ( importCSVs ) where -import qualified Turtle as Turtle hiding (stdout, stderr, proc, procStrictWithErr) +import qualified Turtle hiding (stdout, stderr, proc, procStrictWithErr) import Turtle ((%), (), (<.>)) import Prelude hiding (putStrLn, take) import qualified Data.Text as T @@ -43,7 +43,7 @@ importCSVs' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [(TurtlePath, FileWasGenerated)] importCSVs' opts ch = do - let effectiveDir = effectiveRunDir (baseDir opts) (importRunDir opts) (useRunDir opts) + let effectiveDir = effectiveRunDir (baseDir opts) (importRunDir opts) channelOutLn ch $ Turtle.format ("Collecting input files from "%Turtle.fp) $ pathToTurtle effectiveDir (inputFiles, diff) <- Turtle.time $ Turtle.single . shellToList . onlyFiles $ Turtle.find inputFilePattern (pathToTurtle effectiveDir) let fileCount = length inputFiles 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 @@ -6,9 +6,9 @@ import Control.Monad.IO.Class (MonadIO) import qualified Data.Text as T -import qualified Path as Path +import qualified Path import qualified Path.IO as Path -import qualified Turtle as Turtle +import qualified Turtle import Hledger.Flow.DocHelpers (docURL) @@ -27,7 +27,7 @@ " (or in any of its parent directories).\n\n" ++ "Have a look at the documentation for more information:\n" ++ T.unpack (docURL "getting-started") - show (InvalidTurtleDir d) = "Expected a directory but got this instead: " ++ Turtle.encodeString d + show (InvalidTurtleDir d) = "Expected a directory but got this instead: " ++ Turtle.encodeString d instance Exception PathException @@ -55,3 +55,9 @@ forceTrailingSlash :: TurtlePath -> TurtlePath forceTrailingSlash p = Turtle.directory (p Turtle. "temp") + +pathSize :: Path.Path b Path.Dir -> Int +pathSize p = pathSize' p 0 + +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) diff --git a/src/Hledger/Flow/RuntimeOptions.hs b/src/Hledger/Flow/RuntimeOptions.hs --- a/src/Hledger/Flow/RuntimeOptions.hs +++ b/src/Hledger/Flow/RuntimeOptions.hs @@ -7,7 +7,6 @@ data RuntimeOptions = RuntimeOptions { baseDir :: BaseDir , importRunDir :: RunDir - , useRunDir :: Bool , onlyNewFiles :: Bool , hfVersion :: T.Text , hledgerInfo :: HledgerInfo @@ -19,13 +18,13 @@ 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 instance HasRunDir RuntimeOptions where - importRunDir (RuntimeOptions _ rd _ _ _ _ _ _ _ _) = rd + importRunDir (RuntimeOptions _ rd _ _ _ _ _ _ _) = rd diff --git a/test/BaseDir/Integration.hs b/test/BaseDir/Integration.hs --- a/test/BaseDir/Integration.hs +++ b/test/BaseDir/Integration.hs @@ -10,7 +10,7 @@ import Path import Path.IO -import qualified Turtle as Turtle +import qualified Turtle import qualified Data.Text as T import Hledger.Flow.Common @@ -20,8 +20,7 @@ assertSubDirsForDetermineBaseDir :: AbsDir -> BaseDir -> [Path.Path b Dir] -> IO () assertSubDirsForDetermineBaseDir initialPwd expectedBaseDir importDirs = do - _ <- sequence $ map (assertDetermineBaseDir initialPwd expectedBaseDir) importDirs - return () + sequence_ $ map (assertDetermineBaseDir initialPwd expectedBaseDir) importDirs assertDetermineBaseDir :: AbsDir -> BaseDir -> Path.Path b Dir -> IO () assertDetermineBaseDir initialPwd expectedBaseDir subDir = do @@ -40,9 +39,8 @@ assertFindTestFileUsingRundir bd4 runDir4 setCurrentDir initialPwd - let msg dir = "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - " ++ (show dir) - _ <- sequence $ map (\dir -> assertEqual (msg dir) expectedBaseDir dir) [bd1, bd2, bd3, bd4] - return () + let msg dir = "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - " ++ show dir + sequence_ $ map (\ dir -> assertEqual (msg dir) expectedBaseDir dir) [bd1, bd2, bd3, bd4] assertFindTestFileUsingRundir :: BaseDir -> RunDir -> IO () assertFindTestFileUsingRundir baseDir runDir = do @@ -62,10 +60,9 @@ (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] - return () + 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 @@ -108,6 +105,39 @@ assertSubDirsForDetermineBaseDir initialPwd absoluteBaseDir subDirsRelativeToTop return () +assertRunDirs :: RelDir -> [RelDir] -> [RelDir] -> IO () +assertRunDirs accDir businessAsUsualRundirs specialTreatmentRundirs = do + sequence_ $ map (assertRunDir id "Normal rundirs should not be modified") businessAsUsualRundirs + sequence_ $ map (assertRunDir (\_ -> accDir) "Rundirs deeper than account-level should return the account dir instead") specialTreatmentRundirs + +assertRunDir :: (RelDir -> RelDir) -> String -> RelDir -> IO () +assertRunDir expectedRunDir msg subDir = do + (_, runDir) <- determineBaseDir $ Just $ pathToTurtle subDir + assertEqual msg (expectedRunDir subDir) runDir + +testRunDirsWithTempDir :: AbsDir -> IO () +testRunDirsWithTempDir absoluteTempDir = do + let baseDir = absoluteTempDir [reldir|bd1|] + + let importDir = [reldir|import|] + let ownerDir = importDir [reldir|john|] + let bankDir = ownerDir [reldir|mybank|] + let accDir = bankDir [reldir|myacc|] + let inDir = accDir [reldir|1-in|] + let yearDir = inDir [reldir|2019|] + + createDirIfMissing True $ baseDir yearDir + + withCurrentDir baseDir $ assertRunDirs accDir [accDir, bankDir, ownerDir, importDir] [yearDir, inDir] + +testRunDirs :: Test +testRunDirs = TestCase ( + do + initialPwd <- getCurrentDir + let tmpbase = initialPwd [reldir|test|] [reldir|tmp|] + withTempDir tmpbase "hlflowtest" testRunDirsWithTempDir + ) + testDetermineBaseDir :: Test testDetermineBaseDir = TestCase ( do @@ -118,4 +148,4 @@ ) tests :: Test -tests = TestList [testDetermineBaseDir] +tests = TestList [testDetermineBaseDir, testRunDirs] diff --git a/test/PathHelpers/Unit.hs b/test/PathHelpers/Unit.hs new file mode 100644 --- /dev/null +++ b/test/PathHelpers/Unit.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE QuasiQuotes #-} + +module PathHelpers.Unit where + +import Test.HUnit +import Path +import Hledger.Flow.PathHelpers + +testPathSize :: Test +testPathSize = TestCase ( + do + let d0 = [reldir|.|] + let d1 = [reldir|d1|] + let d1ond0 = d0 [reldir|d1|] + let d2 = d1 [reldir|d2|] + let d3 = d2 [reldir|d3|] + assertEqual "Calculate the path size correctly" 0 (pathSize d0) + assertEqual "Calculate the path size correctly" 1 (pathSize d1) + assertEqual "Calculate the path size correctly" 1 (pathSize d1ond0) + assertEqual "Calculate the path size correctly" 2 (pathSize d2) + assertEqual "Calculate the path size correctly" 3 (pathSize d3) + ) + +tests :: Test +tests = TestList [testPathSize] diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -7,13 +7,14 @@ import Turtle import qualified Common.Unit +import qualified PathHelpers.Unit import qualified Common.Integration import qualified BaseDir.Integration import qualified CSVImport.Unit import qualified CSVImport.Integration tests :: Test -tests = TestList [Common.Unit.tests, Common.Integration.tests, BaseDir.Integration.tests, CSVImport.Unit.tests, CSVImport.Integration.tests] +tests = TestList [Common.Unit.tests, Common.Integration.tests, PathHelpers.Unit.tests, BaseDir.Integration.tests, CSVImport.Unit.tests, CSVImport.Integration.tests] main :: IO Counts main = do diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -64,7 +64,6 @@ defaultOpts bd = RuntimeOptions { baseDir = bd , importRunDir = [reldir|./|] - , useRunDir = True , onlyNewFiles = False , hfVersion = versionInfo' , hledgerInfo = defaultHlInfo