ledgerInclude cleanup

hledger-lib/Hledger/Read/Common.hs

@@ -69,9 +69,9 @@ getParentAccount :: GenParser tok JournalContext String
 getParentAccount = liftM (concat . reverse . ctxAccount) getState
 
 expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath
-expandPath pos fp = liftM mkRelative (expandHome fp)
+expandPath pos fp = liftM mkAbsolute (expandHome fp)
   where
-    mkRelative = combine (takeDirectory (sourceName pos))
+    mkAbsolute = combine (takeDirectory (sourceName pos))
     expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory
                                                       return $ homedir ++ drop 1 inname
                       | otherwise                = return inname

hledger-lib/Hledger/Read/Journal.hs

@@ -123,7 +123,6 @@ import Text.ParserCombinators.Parsec hiding (parse)
 import Prelude hiding (readFile, putStr, putStrLn, print, getContents)
 import System.IO.UTF8
 #endif
-import System.FilePath
 import Hledger.Data.Utils
 import Hledger.Data.Types
 import Hledger.Data.Dates
@@ -209,19 +208,20 @@ ledgerExclamationDirective = do
     _         -> mzero
 
 ledgerInclude :: GenParser Char JournalContext JournalUpdate
-ledgerInclude = do many1 spacenonewline
+ledgerInclude = do
-                   filename <- restofline
+  many1 spacenonewline
-                   outerState <- getState
+  filename <- restofline
-                   outerPos <- getPosition
+  outerState <- getState
-                   let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
+  outerPos <- getPosition
-                   return $ do contents <- expandPath outerPos filename >>= readFileE outerPos
+  return $ do filepath <- expandPath outerPos filename
-                               case runParser journalFile outerState (combine ((takeDirectory . sourceName) outerPos) filename) contents of
+              contents <- readFileOrError outerPos filepath
-                                 Right l   -> l `catchError` (throwError . (inIncluded ++))
+              let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
-                                 Left perr -> throwError $ inIncluded ++ show perr
+              case runParser journalFile outerState filepath contents of
-    where readFileE outerPos filename = ErrorT $ liftM Right (readFile filename) `catch` leftError
+                Right ju -> ju `catchError` (throwError . (inIncluded ++))
-              where leftError err = return $ Left $ currentPos ++ whileReading ++ show err
+                Left err -> throwError $ inIncluded ++ show err
-                    currentPos = show outerPos
+      where readFileOrError pos fp =
-                    whileReading = " reading " ++ show filename ++ ":\n"
+                ErrorT $ liftM Right (readFile fp) `catch`
+                  \err -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show err)
 
 ledgerAccountBegin :: GenParser Char JournalContext JournalUpdate
 ledgerAccountBegin = do many1 spacenonewline