mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib: fix home path expansion in includes
fixes simonmichael/hledger#896
This commit is contained in:
parent
6c57629b8c
commit
8c6a418325
@ -193,10 +193,11 @@ includedirectivep = do
|
||||
getFilePaths
|
||||
:: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath]
|
||||
getFilePaths parseroff parserpos filename = do
|
||||
curdir <- lift $ expandPath (takeDirectory $ sourceName parserpos) ""
|
||||
let curdir = takeDirectory (sourceName parserpos)
|
||||
filename' <- lift $ expandHomePath filename
|
||||
`orRethrowIOError` (show parserpos ++ " locating " ++ filename)
|
||||
-- Compiling filename as a glob pattern works even if it is a literal
|
||||
fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename of
|
||||
fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename' of
|
||||
Right x -> pure x
|
||||
Left e -> customFailure $
|
||||
parseErrorAt parseroff $ "Invalid glob pattern: " ++ e
|
||||
|
@ -4,7 +4,7 @@ Standard imports and utilities which are useful everywhere, or needed low
|
||||
in the module hierarchy. This is the bottom of hledger's module graph.
|
||||
|
||||
-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
|
||||
|
||||
module Hledger.Utils (---- provide these frequently used modules - or not, for clearer api:
|
||||
-- module Control.Monad,
|
||||
@ -143,12 +143,15 @@ applyN n f | n < 1 = id
|
||||
-- Can raise an error.
|
||||
expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in reader parsers
|
||||
expandPath _ "-" = return "-"
|
||||
expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandPath' p
|
||||
where
|
||||
expandPath' ('~':'/':p) = (</> p) <$> getHomeDirectory
|
||||
expandPath' ('~':'\\':p) = (</> p) <$> getHomeDirectory
|
||||
expandPath' ('~':_) = ioError $ userError "~USERNAME in paths is not supported"
|
||||
expandPath' p = return p
|
||||
expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandHomePath p
|
||||
|
||||
-- | Expand user home path indicated by tilde prefix
|
||||
expandHomePath :: FilePath -> IO FilePath
|
||||
expandHomePath = \case
|
||||
('~':'/':p) -> (</> p) <$> getHomeDirectory
|
||||
('~':'\\':p) -> (</> p) <$> getHomeDirectory
|
||||
('~':_) -> ioError $ userError "~USERNAME in paths is not supported"
|
||||
p -> return p
|
||||
|
||||
firstJust ms = case dropWhile (==Nothing) ms of
|
||||
[] -> Nothing
|
||||
|
@ -60,3 +60,14 @@ hledger -f - print
|
||||
<<<
|
||||
include doesnotexist.journal
|
||||
>>>=1
|
||||
|
||||
# 6. include relative to home
|
||||
printf '2018/01/01\n (A) 1\n' >included.journal; HOME="$PWD" hledger -f - print; rm -rf included.journal
|
||||
<<<
|
||||
include ~/included.journal
|
||||
>>>
|
||||
2018/01/01
|
||||
(A) 1
|
||||
|
||||
>>>2
|
||||
>>>=0
|
||||
|
Loading…
Reference in New Issue
Block a user