diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 373294f1c..5057f2f48 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 365454710..cabeac051 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -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 diff --git a/tests/journal/include.test b/tests/journal/include.test index c65c0065e..7b8582c14 100644 --- a/tests/journal/include.test +++ b/tests/journal/include.test @@ -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