Skip to content

Commit bee8986

Browse files
authored
Merge pull request #41 from apauley/determine-base-dir
Detect the hledger-flow base directory correctly, even when in a subdirectory
2 parents e9ae72f + 45397ae commit bee8986

File tree

7 files changed

+176
-105
lines changed

7 files changed

+176
-105
lines changed

ChangeLog.md

+5
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,10 @@
11
# Changelog for [hledger-flow](https://github.com/apauley/hledger-flow)
22

3+
## 0.11.3
4+
5+
- Detect the hledger-flow base directory correctly, even when in a subdirectory. Similar to how git behaves.
6+
- Change the version subcommand into a flag - thanks to [jecaro](https://github.com/apauley/hledger-flow/pull/38) for the contribution.
7+
38
## 0.11.2
49

510
- Improved display of external process output

app/Main.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ main = do
3333

3434
toImportOptions :: SubcommandParams -> IO IT.ImportOptions
3535
toImportOptions params = do
36-
bd <- dirOrPwd $ maybeBaseDir params
36+
bd <- determineBaseDir $ maybeBaseDir params
3737
hli <- hledgerInfoFromPath $ hledgerPathOpt params
3838
return IT.ImportOptions { IT.baseDir = bd
3939
, IT.hledgerInfo = hli
@@ -43,7 +43,7 @@ toImportOptions params = do
4343

4444
toReportOptions :: SubcommandParams -> IO RT.ReportOptions
4545
toReportOptions params = do
46-
bd <- dirOrPwd $ maybeBaseDir params
46+
bd <- determineBaseDir $ maybeBaseDir params
4747
hli <- hledgerInfoFromPath $ hledgerPathOpt params
4848
return RT.ReportOptions { RT.baseDir = bd
4949
, RT.hledgerInfo = hli

package.yaml

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: hledger-flow
2-
version: 0.11.2.0
2+
version: 0.11.3.0
33
synopsis: An hledger workflow focusing on automated statement import and classification.
44
category: Finance, Console
55
license: GPL-3

src/Hledger/Flow/Common.hs

+30-44
Original file line numberDiff line numberDiff line change
@@ -1,49 +1,6 @@
11
{-# LANGUAGE OverloadedStrings #-}
22

3-
module Hledger.Flow.Common
4-
( docURL
5-
, versionInfo
6-
, hledgerPathFromOption
7-
, hledgerVersionFromPath
8-
, hledgerInfoFromPath
9-
, showCmdArgs
10-
, consoleChannelLoop
11-
, terminateChannelLoop
12-
, dummyLogger
13-
, channelOut, channelOutLn
14-
, channelErr, channelErrLn
15-
, errExit
16-
, logVerbose
17-
, timeAndExitOnErr, timeAndExitOnErr'
18-
, parAwareProc
19-
, inprocWithErrFun
20-
, verboseTestFile
21-
, relativeToBase
22-
, relativeToBase'
23-
, lsDirs
24-
, onlyFiles
25-
, onlyDirs
26-
, filterPaths
27-
, changePathAndExtension
28-
, basenameLine
29-
, buildFilename
30-
, shellToList
31-
, firstExistingFile
32-
, groupValuesBy
33-
, groupIncludeFiles
34-
, allYearIncludeFiles
35-
, yearsIncludeMap
36-
, extraIncludesForFile
37-
, groupPairs
38-
, pairBy
39-
, includePreamble
40-
, toIncludeFiles
41-
, toIncludeLine
42-
, groupAndWriteIncludeFiles
43-
, writeIncludesUpTo
44-
, dirOrPwd
45-
, extractImportDirs
46-
) where
3+
module Hledger.Flow.Common where
474

485
import Turtle
496
import Prelude hiding (FilePath, putStrLn)
@@ -435,6 +392,35 @@ changeOutputPath :: FilePath -> FilePath -> FilePath
435392
changeOutputPath newOutputLocation srcFile = mconcat $ map changeSrcDir $ splitDirectories srcFile
436393
where changeSrcDir file = if (file == "1-in/" || file == "2-preprocessed/") then newOutputLocation else file
437394

395+
errorMessageBaseDir :: FilePath -> Text
396+
errorMessageBaseDir startDir = format ("Unable to find an hledger-flow import directory at '"%fp
397+
%"' (or in any of its parent directories).\n\n"
398+
%"Have a look at the documentation for more information:\n"%s)
399+
startDir (docURL "input-files")
400+
401+
determineBaseDir :: Maybe FilePath -> IO FilePath
402+
determineBaseDir (Just suppliedDir) = determineBaseDir' suppliedDir
403+
determineBaseDir Nothing = pwd >>= determineBaseDir'
404+
405+
determineBaseDir' :: FilePath -> IO FilePath
406+
determineBaseDir' startDir = do
407+
ee <- determineBaseDir'' startDir startDir
408+
case ee of
409+
Right bd -> return bd
410+
Left t -> die t
411+
412+
determineBaseDir'' :: FilePath -> FilePath -> IO (Either Text FilePath)
413+
determineBaseDir'' startDir currentDir = do
414+
foundBaseDir <- testdir $ currentDir </> "import"
415+
if foundBaseDir
416+
then return $ Right $ forceTrailingSlash currentDir
417+
else
418+
do
419+
let doneSearching = (currentDir `elem` ["/", "./"])
420+
if doneSearching
421+
then return $ Left $ errorMessageBaseDir startDir
422+
else determineBaseDir'' startDir $ parent currentDir
423+
438424
dirOrPwd :: Maybe FilePath -> IO FilePath
439425
dirOrPwd maybeBaseDir = fmap forceTrailingSlash (fromMaybe pwd $ fmap realpath maybeBaseDir)
440426

test/CSVImport/Integration.hs

+1-57
Original file line numberDiff line numberDiff line change
@@ -16,60 +16,6 @@ import Hledger.Flow.Import.Types
1616
import Hledger.Flow.Common
1717
import Control.Concurrent.STM
1818

19-
testHiddenFiles = TestCase (
20-
sh (
21-
do
22-
tmpdir <- using (mktempdir "." "hlflow")
23-
let tmpJournals = map (tmpdir </>) journalFiles :: [FilePath]
24-
let tmpExtras = map (tmpdir </>) extraFiles :: [FilePath]
25-
let tmpHidden = map (tmpdir </>) hiddenFiles :: [FilePath]
26-
let onDisk = List.sort $ tmpJournals ++ tmpExtras ++ tmpHidden
27-
touchAll onDisk
28-
filtered <- (fmap List.sort) $ shellToList $ onlyFiles $ select onDisk
29-
let expected = List.sort $ tmpExtras ++ tmpJournals
30-
liftIO $ assertEqual "Hidden files should be excluded" expected filtered
31-
)
32-
)
33-
34-
testDirOrPwd = TestCase (
35-
sh (
36-
do
37-
currentDir <- fmap (\p -> directory (p </> "t")) pwd
38-
tmpdir <- using (mktempdir "." "hlflow")
39-
let fooDir = collapse $ currentDir </> tmpdir </> "foo/"
40-
let barDir = collapse $ currentDir </> tmpdir </> "bar/"
41-
mkdir fooDir
42-
mkdir barDir
43-
d1 <- liftIO $ dirOrPwd Nothing
44-
liftIO $ assertEqual "dirOrPwd returns pwd as a fallback" currentDir d1
45-
liftIO $ assertEqual "dirOrPwd assumes the fallback is a directory" (directory d1) d1
46-
d2 <- liftIO $ dirOrPwd $ Just $ tmpdir </> "foo"
47-
liftIO $ assertEqual "dirOrPwd returns the supplied dir - no trailing slash supplied" fooDir d2
48-
liftIO $ assertEqual "dirOrPwd assumes the supplied dir is a directory - no trailing slash supplied" (directory d2) d2
49-
d3 <- liftIO $ dirOrPwd $ Just $ tmpdir </> "bar/"
50-
liftIO $ assertEqual "dirOrPwd returns the supplied dir - trailing slash supplied" barDir d3
51-
liftIO $ assertEqual "dirOrPwd assumes the supplied dir is a directory - trailing slash supplied" (directory d3) d3
52-
)
53-
)
54-
55-
testFilterPaths = TestCase (
56-
sh (
57-
do
58-
tmpdir <- using (mktempdir "." "hlflow")
59-
let tmpJournals = map (tmpdir </>) journalFiles :: [FilePath]
60-
let tmpExtras = map (tmpdir </>) extraFiles :: [FilePath]
61-
let tmpHidden = map (tmpdir </>) hiddenFiles :: [FilePath]
62-
let onDisk = List.sort $ tmpJournals ++ tmpExtras ++ tmpHidden
63-
touchAll onDisk
64-
65-
let nonExistant = map (tmpdir </>) ["where", "is", "my", "mind"]
66-
let toFilter = nonExistant ++ onDisk
67-
filtered <- single $ filterPaths testfile toFilter
68-
let actual = List.sort filtered
69-
liftIO $ assertEqual "The filtered paths should exclude files not actually on disk" onDisk actual
70-
)
71-
)
72-
7319
testExtraIncludesForFile = TestCase (
7420
sh (
7521
do
@@ -223,9 +169,7 @@ testWriteIncludeFiles = TestCase (
223169
<> "!include 3-journal/2018/2018-12-30.journal\n"
224170
actualJane7Contents <- liftIO $ readTextFile jane7
225171
liftIO $ assertEqual "Jane7: The include file contents should be the journal files" expectedJane7Contents actualJane7Contents
226-
227172
)
228173
)
229174

230-
tests = TestList [testDirOrPwd, testExtraIncludesForFile, testIncludesPrePost, testIncludesOpeningClosing,
231-
testHiddenFiles, testFilterPaths, testWriteIncludeFiles]
175+
tests = TestList [testExtraIncludesForFile, testIncludesPrePost, testIncludesOpeningClosing, testWriteIncludeFiles]

test/Common/Integration.hs

+135
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,135 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE OverloadedLists #-}
3+
4+
module Common.Integration (tests) where
5+
6+
import Test.HUnit
7+
import Turtle
8+
import Prelude hiding (FilePath)
9+
import qualified Data.Map.Strict as Map
10+
import qualified Control.Foldl as Fold
11+
import qualified Data.Text as T
12+
import qualified Data.List as List (sort)
13+
14+
import TestHelpers
15+
import Hledger.Flow.Import.Types
16+
import Hledger.Flow.Common
17+
import Control.Concurrent.STM
18+
19+
testHiddenFiles = TestCase (
20+
sh (
21+
do
22+
tmpdir <- using (mktempdir "." "hlflow")
23+
let tmpJournals = map (tmpdir </>) journalFiles :: [FilePath]
24+
let tmpExtras = map (tmpdir </>) extraFiles :: [FilePath]
25+
let tmpHidden = map (tmpdir </>) hiddenFiles :: [FilePath]
26+
let onDisk = List.sort $ tmpJournals ++ tmpExtras ++ tmpHidden
27+
touchAll onDisk
28+
filtered <- (fmap List.sort) $ shellToList $ onlyFiles $ select onDisk
29+
let expected = List.sort $ tmpExtras ++ tmpJournals
30+
liftIO $ assertEqual "Hidden files should be excluded" expected filtered
31+
)
32+
)
33+
34+
testDirOrPwd = TestCase (
35+
sh (
36+
do
37+
currentDir <- fmap (\p -> directory (p </> "t")) pwd
38+
tmpdir <- using (mktempdir "." "hlflow")
39+
let fooDir = collapse $ currentDir </> tmpdir </> "foo/"
40+
let barDir = collapse $ currentDir </> tmpdir </> "bar/"
41+
mkdir fooDir
42+
mkdir barDir
43+
d1 <- liftIO $ dirOrPwd Nothing
44+
liftIO $ assertEqual "dirOrPwd returns pwd as a fallback" currentDir d1
45+
liftIO $ assertEqual "dirOrPwd assumes the fallback is a directory" (directory d1) d1
46+
d2 <- liftIO $ dirOrPwd $ Just $ tmpdir </> "foo"
47+
liftIO $ assertEqual "dirOrPwd returns the supplied dir - no trailing slash supplied" fooDir d2
48+
liftIO $ assertEqual "dirOrPwd assumes the supplied dir is a directory - no trailing slash supplied" (directory d2) d2
49+
d3 <- liftIO $ dirOrPwd $ Just $ tmpdir </> "bar/"
50+
liftIO $ assertEqual "dirOrPwd returns the supplied dir - trailing slash supplied" barDir d3
51+
liftIO $ assertEqual "dirOrPwd assumes the supplied dir is a directory - trailing slash supplied" (directory d3) d3
52+
)
53+
)
54+
55+
testDetermineBaseDir = TestCase (
56+
sh (
57+
do
58+
error1 <- liftIO $ determineBaseDir'' "/path/to/dir" "/path/to/dir"
59+
liftIO $ assertEqual "determineBaseDir produces an error message when given a non-existant dir" (Left $ errorMessageBaseDir "/path/to/dir") error1
60+
tmpdir <- using (mktempdir "." "hlflow")
61+
62+
let unrelatedDir = collapse $ tmpdir </> "unrelated"
63+
mkdir unrelatedDir
64+
65+
bdUnrelated <- liftIO $ determineBaseDir'' unrelatedDir unrelatedDir
66+
liftIO $ assertEqual "determineBaseDir produces an error message when it cannot find a baseDir" (Left $ errorMessageBaseDir unrelatedDir) bdUnrelated
67+
68+
currentDir <- pwd
69+
let baseDir = forceTrailingSlash $ collapse $ currentDir </> tmpdir </> "bd1"
70+
71+
let importDir = baseDir </> "import"
72+
let ownerDir = importDir </> "john"
73+
let bankDir = ownerDir </> "mybank"
74+
let accDir = bankDir </> "myacc"
75+
let inDir = accDir </> "1-in"
76+
let yearDir = inDir </> "2019"
77+
mktree yearDir
78+
79+
let reportDir = baseDir </> "report"
80+
mkdir reportDir
81+
82+
cd baseDir
83+
bd <- liftIO $ determineBaseDir Nothing
84+
liftIO $ assertEqual "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - in the base dir" baseDir bd
85+
86+
cd reportDir
87+
bdReport <- liftIO $ determineBaseDir Nothing
88+
liftIO $ assertEqual "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - report dir" baseDir bdReport
89+
90+
cd yearDir
91+
bdYear <- liftIO $ determineBaseDir Nothing
92+
liftIO $ assertEqual "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - year dir" baseDir bdYear
93+
94+
cd inDir
95+
bdIn <- liftIO $ determineBaseDir Nothing
96+
liftIO $ assertEqual "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - input dir" baseDir bdIn
97+
98+
cd accDir
99+
bdAcc <- liftIO $ determineBaseDir Nothing
100+
liftIO $ assertEqual "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - account dir" baseDir bdAcc
101+
102+
cd bankDir
103+
bdBank <- liftIO $ determineBaseDir Nothing
104+
liftIO $ assertEqual "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - bank dir" baseDir bdBank
105+
106+
cd ownerDir
107+
bdOwner <- liftIO $ determineBaseDir Nothing
108+
liftIO $ assertEqual "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - owner dir" baseDir bdOwner
109+
110+
cd importDir
111+
bdImport <- liftIO $ determineBaseDir Nothing
112+
liftIO $ assertEqual "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - import dir" baseDir bdImport
113+
)
114+
)
115+
116+
testFilterPaths = TestCase (
117+
sh (
118+
do
119+
tmpdir <- using (mktempdir "." "hlflow")
120+
let tmpJournals = map (tmpdir </>) journalFiles :: [FilePath]
121+
let tmpExtras = map (tmpdir </>) extraFiles :: [FilePath]
122+
let tmpHidden = map (tmpdir </>) hiddenFiles :: [FilePath]
123+
let onDisk = List.sort $ tmpJournals ++ tmpExtras ++ tmpHidden
124+
touchAll onDisk
125+
126+
let nonExistant = map (tmpdir </>) ["where", "is", "my", "mind"]
127+
let toFilter = nonExistant ++ onDisk
128+
filtered <- single $ filterPaths testfile toFilter
129+
let actual = List.sort filtered
130+
liftIO $ assertEqual "The filtered paths should exclude files not actually on disk" onDisk actual
131+
)
132+
)
133+
134+
135+
tests = TestList [testDirOrPwd, testDetermineBaseDir, testHiddenFiles, testFilterPaths]

test/Spec.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -8,10 +8,11 @@ import Turtle
88
import Prelude hiding (FilePath)
99

1010
import qualified Common.Unit
11+
import qualified Common.Integration
1112
import qualified CSVImport.Unit
1213
import qualified CSVImport.Integration
1314

14-
tests = TestList [Common.Unit.tests, CSVImport.Unit.tests, CSVImport.Integration.tests]
15+
tests = TestList [Common.Unit.tests, Common.Integration.tests, CSVImport.Unit.tests, CSVImport.Integration.tests]
1516

1617
main :: IO Counts
1718
main = do

0 commit comments

Comments
 (0)