lib: fix home path expansion in includes

fixes simonmichael/hledger#896

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

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
+expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandHomePath p
-  where
+
-    expandPath' ('~':'/':p)  = (</> p) <$> getHomeDirectory
+-- | Expand user home path indicated by tilde prefix
-    expandPath' ('~':'\\':p) = (</> p) <$> getHomeDirectory
+expandHomePath :: FilePath -> IO FilePath
-    expandPath' ('~':_)      = ioError $ userError "~USERNAME in paths is not supported"
+expandHomePath = \case
-    expandPath' p            = return p
+    ('~':'/':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

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