support tilde (~) in journal and rules file paths

This commit is contained in:
Simon Michael 2012-05-30 08:36:01 +00:00
parent 776ad2a098
commit 0b96a767b4
5 changed files with 30 additions and 31 deletions

View File

@ -179,7 +179,8 @@ includedirective = do
filename <- restofline
outerState <- getState
outerPos <- getPosition
return $ do filepath <- expandPath outerPos filename
let curdir = takeDirectory (sourceName outerPos)
return $ do filepath <- expandPath curdir filename
txt <- readFileOrError outerPos filepath
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
case runParser journal outerState filepath txt of

View File

@ -26,7 +26,9 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c
-- the rest need to be done in each module I think
)
where
import Control.Monad.Error
import Control.Monad (liftM)
import Control.Monad.Error (MonadIO)
import Control.Monad.IO.Class (liftIO)
import Data.Char
import Data.List
import Data.Maybe
@ -35,7 +37,7 @@ import Data.Time.LocalTime
import Data.Tree
import Debug.Trace
import System.Directory (getHomeDirectory)
import System.FilePath(takeDirectory,combine)
import System.FilePath((</>), isRelative)
import Test.HUnit
import Text.ParserCombinators.Parsec
import Text.Printf
@ -401,15 +403,16 @@ isRight = not . isLeft
applyN :: Int -> (a -> a) -> a -> a
applyN n f = (!! n) . iterate f
-- | Convert a possibly relative, possibly tilde-containing file path to an absolute one.
-- using the current directory from a parsec source position. ~username is not supported.
expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath
expandPath pos fp = liftM mkAbsolute (expandHome fp)
-- | Convert a possibly relative, possibly tilde-containing file path to an absolute one,
-- given the current directory. ~username is not supported. Leave "-" unchanged.
expandPath :: MonadIO m => FilePath -> FilePath -> m 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
mkAbsolute = combine (takeDirectory (sourceName pos))
expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory
return $ homedir ++ drop 1 inname
| otherwise = return inname
expandPath' ('~':'/':p) = liftIO $ (</> p) `fmap` getHomeDirectory
expandPath' ('~':'\\':p) = liftIO $ (</> p) `fmap` getHomeDirectory
expandPath' ('~':_) = error' "~USERNAME in paths is not supported"
expandPath' p = return p
firstJust ms = case dropWhile (==Nothing) ms of
[] -> Nothing

View File

@ -456,25 +456,18 @@ defaultBalanceFormatString = [
, FormatField True Nothing Nothing AccountField
]
-- | Get the journal file path from options, an environment variable, or a default.
-- If the path contains a literal tilde raise an error to avoid confusion. XXX
-- | Get the (tilde-expanded, absolute) journal file path from options, an environment variable, or a default.
journalFilePathFromOpts :: CliOpts -> IO String
journalFilePathFromOpts opts = do
f <- defaultJournalPath
let f' = fromMaybe f $ file_ opts
if '~' `elem` f'
then error' $ printf "~ in the journal file path is not supported, please adjust (%s)" f'
else return f'
d <- getCurrentDirectory
expandPath d $ fromMaybe f $ file_ opts
-- | Get the rules file path from options, if any.
-- If the path contains a literal tilde raise an error to avoid confusion. XXX
rulesFilePathFromOpts :: CliOpts -> Maybe FilePath
rulesFilePathFromOpts opts =
case rules_file_ opts of
Nothing -> Nothing
Just f -> if '~' `elem` f
then error' $ printf "~ in file paths is not supported, please adjust (%s)" f
else Just f
-- | Get the (tilde-expanded) rules file path from options, if any.
rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
rulesFilePathFromOpts opts = do
d <- getCurrentDirectory
maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts
aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]
aliasesFromOpts = map parseAlias . alias_

View File

@ -48,8 +48,10 @@ withJournalDo opts cmd = do
-- We kludgily read the file before parsing to grab the full text, unless
-- it's stdin, or it doesn't exist and we are adding. We read it strictly
-- to let the add command work.
journalFilePathFromOpts opts >>= readJournalFile Nothing (rulesFilePathFromOpts opts) >>=
either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts))
rulespath <- rulesFilePathFromOpts opts
journalpath <- journalFilePathFromOpts opts
ej <- readJournalFile Nothing rulespath journalpath
either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts)) ej
-- -- | Get a journal from the given string and options, or throw an error.
-- readJournalWithOpts :: CliOpts -> String -> IO Journal

View File

@ -5,7 +5,7 @@
income:unknown $-50
assets:myacct $50
>>>2 /using conversion rules file t.rules/
>>>2 /using conversion rules file.*t.rules/
>>>=0
# 2. reading CSV with in-field and out-field
@ -22,7 +22,7 @@
expenses:unknown $50
Assets:MyAccount $-50
>>>2 /using conversion rules file [0-9]+\.rules/
>>>2 /using conversion rules file.*[0-9]+\.rules/
>>>=0
# 3. report rules parse error
@ -32,6 +32,6 @@
# income:unknown $-50
# assets:myacct $50
# >>>2 /using conversion rules file t.rules/
# >>>2 /using conversion rules file.*t.rules/
# >>>=0