Make --enable-future-rundir the default, and deprecate the option.

Ensure that the deepest rundir is the account directory, because the program
doesn't generate include files correctly in directories below the account level.

Author: apauley

CONTRIBUTING.org

@@ -120,20 +120,6 @@ Usually this means adding this to your =~/.bashrc=:
     PATH="${HOME}/.local/bin:${PATH}"
 #+END_SRC
 
-**** Building with older Haskell Versions
-   :PROPERTIES:
-   :CUSTOM_ID: building-with-older-haskell-versions
-   :END:
-
-To build using an older version of GHC and related dependencies, point
-stack to one of the other yaml files:
-
-#+NAME: stack-build-versions
-#+BEGIN_SRC sh
-    stack test --stack-yaml stack-8.4.4.yaml
-    stack test --stack-yaml stack-8.2.2.yaml
-#+END_SRC
-
 *** Find an Issue
     :PROPERTIES:
     :CUSTOM_ID: find-an-issue

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)

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 qualified Hledger.Flow.RuntimeOptions as RT
 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 @@ main = do
 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 @@ toRuntimeOptionsReport mainParams' subParams' = do
   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 @@ verboseParser = MainParams
 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

package.yaml

@@ -1,11 +1,11 @@
 name:                hledger-flow
-version:             0.14.0.0
+version:             0.14.1.0
 synopsis:            An hledger workflow focusing on automated statement import and classification.
 category:            Finance, Console
 license:             GPL-3
 author:              "Andreas Pauley <[email protected]>"
 maintainer:          "Andreas Pauley <[email protected]>"
-copyright:           "2018 Andreas Pauley"
+copyright:           "2020 Andreas Pauley"
 github:              "apauley/hledger-flow"
 bug-reports:         https://github.com/apauley/hledger-flow/issues
 

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 Data.Maybe
 
 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 startDir = determineBaseDirFromStartDir' startDir s
 
 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 @@ relativeToBase' bd p = if forceTrailingSlash bd == forceTrailingSlash p then "./
 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

src/Hledger/Flow/CSVImport.hs

@@ -4,7 +4,7 @@ module Hledger.Flow.CSVImport
     ( 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 @@ inputFilePattern = Turtle.contains (Turtle.once (Turtle.oneOf pathSeparators) <>
 
 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

src/Hledger/Flow/PathHelpers.hs

@@ -6,9 +6,9 @@ import Control.Monad.Catch (MonadThrow, Exception, throwM)
 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 @@ instance Show PathException where
     " (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 @@ pathToTurtle = Turtle.decodeString . Path.toFilePath
 
 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)

src/Hledger/Flow/RuntimeOptions.hs

@@ -7,7 +7,6 @@ import Hledger.Flow.Types
 
 data RuntimeOptions = RuntimeOptions { baseDir :: BaseDir
                                      , importRunDir :: RunDir
-                                     , useRunDir :: Bool
                                      , onlyNewFiles :: Bool
                                      , hfVersion :: T.Text
                                      , hledgerInfo :: HledgerInfo
@@ -19,13 +18,13 @@ data RuntimeOptions = RuntimeOptions { baseDir :: BaseDir
   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

stack-8.2.2.yaml

@@ -18,7 +18,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: nightly-2020-08-27
+resolver: nightly-2020-09-02
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.

stack-8.4.4.yaml

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 523649
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/8/27.yaml
-    sha256: 95012648db1b2180e3d7e0a3d44bc2a61b6854028382674724fee7ffa24300c3
-  original: nightly-2020-08-27
+    size: 527775
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/9/2.yaml
+    sha256: 92ec78ae38830f06ec9307c5ce346ae93982fab6179eb10dec9d57d5069c7f14
+  original: nightly-2020-09-02

stack.yaml

@@ -10,7 +10,7 @@ import Test.HUnit
 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 @@ import Hledger.Flow.PathHelpers
 
 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 @@ assertDetermineBaseDir initialPwd expectedBaseDir subDir = do
   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 @@ assertCurrentDirVariations absoluteTempDir bdRelativeToTempDir = do
   (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 @@ testBaseDirWithTempDir initialPwd absoluteTempDir = do
   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 @@ testDetermineBaseDir = TestCase (
   )
 
 tests :: Test
-tests = TestList [testDetermineBaseDir]
+tests = TestList [testDetermineBaseDir, testRunDirs]

stack.yaml.lock

@@ -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]