packages feed

hledger-flow 0.14.0.0 → 0.14.1.0

raw patch · 11 files changed

+135/−40 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Hledger.Flow.BaseDir: determineBaseDir' :: AbsDir -> Maybe TurtlePath -> IO (BaseDir, RunDir)
- Hledger.Flow.BaseDir: determineBaseDirFromStartDir :: AbsDir -> IO (BaseDir, RunDir)
- Hledger.Flow.BaseDir: determineBaseDirFromStartDir' :: (MonadIO m, MonadThrow m) => AbsDir -> AbsDir -> m (BaseDir, RunDir)
- Hledger.Flow.RuntimeOptions: [useRunDir] :: RuntimeOptions -> Bool
+ Hledger.Flow.PathHelpers: pathSize :: Path b Dir -> Int
+ Hledger.Flow.PathHelpers: pathSize' :: Path b Dir -> Int -> Int
- Hledger.Flow.BaseDir: effectiveRunDir :: BaseDir -> RunDir -> Bool -> AbsDir
+ Hledger.Flow.BaseDir: effectiveRunDir :: BaseDir -> RunDir -> AbsDir
- Hledger.Flow.RuntimeOptions: RuntimeOptions :: BaseDir -> RunDir -> Bool -> Bool -> Text -> HledgerInfo -> SystemInfo -> Bool -> Bool -> Bool -> RuntimeOptions
+ Hledger.Flow.RuntimeOptions: RuntimeOptions :: BaseDir -> RunDir -> Bool -> Text -> HledgerInfo -> SystemInfo -> Bool -> Bool -> Bool -> RuntimeOptions

Files

ChangeLog.md view
@@ -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 view
@@ -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
hledger-flow.cabal view
@@ -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 <https://github.com/apauley/hledger-flow#readme> category:       Finance, Console@@ -15,7 +15,7 @@ bug-reports:    https://github.com/apauley/hledger-flow/issues author:         Andreas Pauley <hledger-flow@pauley.org.za> maintainer:     Andreas Pauley <hledger-flow@pauley.org.za>-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:
src/Hledger/Flow/BaseDir.hs view
@@ -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
src/Hledger/Flow/CSVImport.hs view
@@ -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
src/Hledger/Flow/PathHelpers.hs view
@@ -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)
src/Hledger/Flow/RuntimeOptions.hs view
@@ -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
test/BaseDir/Integration.hs view
@@ -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]
+ test/PathHelpers/Unit.hs view
@@ -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]
test/Spec.hs view
@@ -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
test/TestHelpers.hs view
@@ -64,7 +64,6 @@ defaultOpts bd = RuntimeOptions {     baseDir = bd   , importRunDir = [reldir|./|]-  , useRunDir = True   , onlyNewFiles = False   , hfVersion = versionInfo'   , hledgerInfo = defaultHlInfo