From d132f5e45a013f2a209b1a65393d892bc5e9d95e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 22 Sep 2010 21:52:04 +0000 Subject: [PATCH] ledgerInclude cleanup --- hledger-lib/Hledger/Read/Common.hs | 4 ++-- hledger-lib/Hledger/Read/Journal.hs | 28 ++++++++++++++-------------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 7c38af3be..39546fdfe 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read/Journal.hs b/hledger-lib/Hledger/Read/Journal.hs index 5b47d1b34..090b66d70 100644 --- a/hledger-lib/Hledger/Read/Journal.hs +++ b/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 - filename <- restofline - outerState <- getState - outerPos <- getPosition - let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" - return $ do contents <- expandPath outerPos filename >>= readFileE outerPos - case runParser journalFile outerState (combine ((takeDirectory . sourceName) outerPos) filename) contents of - Right l -> l `catchError` (throwError . (inIncluded ++)) - Left perr -> throwError $ inIncluded ++ show perr - where readFileE outerPos filename = ErrorT $ liftM Right (readFile filename) `catch` leftError - where leftError err = return $ Left $ currentPos ++ whileReading ++ show err - currentPos = show outerPos - whileReading = " reading " ++ show filename ++ ":\n" +ledgerInclude = do + many1 spacenonewline + filename <- restofline + outerState <- getState + outerPos <- getPosition + return $ do filepath <- expandPath outerPos filename + contents <- readFileOrError outerPos filepath + let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" + case runParser journalFile outerState filepath contents of + Right ju -> ju `catchError` (throwError . (inIncluded ++)) + Left err -> throwError $ inIncluded ++ show err + where readFileOrError pos fp = + 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