Handle !includes relative to the including file
This commit is contained in:
		
							parent
							
								
									25526cf4b3
								
							
						
					
					
						commit
						fd8587fbdf
					
				| @ -26,6 +26,7 @@ import Ledger.Entry | ||||
| import Ledger.Commodity | ||||
| import Ledger.TimeLog | ||||
| import Ledger.RawLedger | ||||
| import System.FilePath(takeDirectory,combine) | ||||
| 
 | ||||
| 
 | ||||
| -- utils | ||||
| @ -115,7 +116,7 @@ ledgerInclude = do many1 spacenonewline | ||||
|                    outerState <- getState | ||||
|                    outerPos <- getPosition | ||||
|                    let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" | ||||
|                    return $ do contents <- expandPath filename >>= readFileE outerPos | ||||
|                    return $ do contents <- expandPath outerPos filename >>= readFileE outerPos | ||||
|                                case runParser ledgerFile outerState filename contents of | ||||
|                                  Right l   -> l `catchError` (\err -> throwError $ inIncluded ++ err) | ||||
|                                  Left perr -> throwError $ inIncluded ++ show perr | ||||
| @ -124,10 +125,13 @@ ledgerInclude = do many1 spacenonewline | ||||
|                     currentPos = show outerPos | ||||
|                     whileReading = " reading " ++ show filename ++ ":\n" | ||||
| 
 | ||||
| expandPath :: (MonadIO m) => FilePath -> m FilePath | ||||
| expandPath inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory | ||||
|                                                   return $ homedir ++ drop 1 inname | ||||
|                   | otherwise                = return inname | ||||
| expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath | ||||
| expandPath pos fp = liftM mkRelative (expandHome fp) | ||||
|   where | ||||
|     mkRelative = combine (takeDirectory (sourceName pos)) | ||||
|     expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory | ||||
|                                                       return $ homedir ++ drop 1 inname | ||||
|                       | otherwise                = return inname | ||||
| 
 | ||||
| ledgerAccountBegin :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger)) | ||||
| ledgerAccountBegin = do many1 spacenonewline | ||||
|  | ||||
| @ -41,7 +41,8 @@ Executable hledger | ||||
|                   time,  | ||||
|                   HUnit,  | ||||
|                   mtl,  | ||||
|                   bytestring | ||||
|                   bytestring, | ||||
|                   filepath | ||||
|   Other-Modules:  BalanceCommand | ||||
|                   Options | ||||
|                   PrintCommand | ||||
| @ -81,7 +82,7 @@ Executable hledger | ||||
| 
 | ||||
| Library | ||||
|   Build-Depends:  base, containers, haskell98, directory, parsec, regex-compat, | ||||
|                   old-locale, time, HUnit | ||||
|                   old-locale, time, HUnit, filepath | ||||
|   Exposed-modules:Ledger | ||||
|                   Ledger.Account | ||||
|                   Ledger.AccountName | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user