simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 10:47:29 +03:00
Code Issues Projects Releases Wiki Activity

csv: include path is relative to current (close #198)

Browse Source
This commit is contained in:
Simon Michael 2014-12-02 10:50:31 -08:00
parent 09a6f79334
commit 733a7b12ef
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -331,7 +331,7 @@ getDirective directivename = lookup directivename . rdirectives
parseRulesFile :: FilePath -> ErrorT String IO CsvRules parseRulesFile :: FilePath -> ErrorT String IO CsvRules
parseRulesFile f = do parseRulesFile f = do
s <- liftIO $ (readFile' f >>= expandIncludes) s <- liftIO $ (readFile' f >>= expandIncludes (takeDirectory f))
let rules = parseCsvRules f s let rules = parseCsvRules f s
case rules of case rules of
Left e -> ErrorT $ return $ Left $ show e Left e -> ErrorT $ return $ Left $ show e
@ -345,14 +345,15 @@ parseRulesFile f = do
-- | Pre-parse csv rules to interpolate included files, recursively. -- | Pre-parse csv rules to interpolate included files, recursively.
-- This is a cheap hack to avoid rewriting the existing parser. -- This is a cheap hack to avoid rewriting the existing parser.
expandIncludes :: String -> IO String expandIncludes :: FilePath -> String -> IO String
expandIncludes s = do expandIncludes basedir content = do
let (ls,rest) = break (isPrefixOf "include") $ lines s let (ls,rest) = break (isPrefixOf "include") $ lines content
case rest of case rest of
[] -> return $ unlines ls [] -> return $ unlines ls
(('i':'n':'c':'l':'u':'d':'e':f):ls') -> do (('i':'n':'c':'l':'u':'d':'e':f):ls') -> do
let f' = dropWhile isSpace f let f' = basedir </> dropWhile isSpace f
included <- readFile f' >>= expandIncludes basedir' = takeDirectory f'
included <- readFile f' >>= expandIncludes basedir'
return $ unlines [unlines ls, included, unlines ls'] return $ unlines [unlines ls, included, unlines ls']
ls' -> return $ unlines $ ls ++ ls' -- should never get here ls' -> return $ unlines $ ls ++ ls' -- should never get here