read system cleanup, require conversion rules from a file to simplify API
This commit is contained in:
parent
ca5d5020e1
commit
d4451ce5e3
@ -183,8 +183,8 @@ data Reader = Reader {
|
|||||||
rFormat :: Format
|
rFormat :: Format
|
||||||
-- quickly check if this reader can probably handle the given file path and file content
|
-- quickly check if this reader can probably handle the given file path and file content
|
||||||
,rDetector :: FilePath -> String -> Bool
|
,rDetector :: FilePath -> String -> Bool
|
||||||
-- parse the given string, using the given parsing rules if any, returning a journal or error aware of the given file path
|
-- parse the given string, using the given parse rules file if any, returning a journal or error aware of the given file path
|
||||||
,rParser :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
|
,rParser :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal
|
||||||
}
|
}
|
||||||
|
|
||||||
-- data format parse/conversion rules
|
-- data format parse/conversion rules
|
||||||
|
|||||||
@ -1,21 +1,21 @@
|
|||||||
{-|
|
{-|
|
||||||
|
|
||||||
This is the entry point to hledger's reading system, which can read
|
This is the entry point to hledger's reading system, which can read
|
||||||
Journals from various data formats. Use this module if you want to
|
Journals from various data formats. Use this module if you want to parse
|
||||||
parse journal data or read journal files; it should not be necessary
|
journal data or read journal files. Generally it should not be necessary
|
||||||
to import modules below this one.
|
to import modules below this one.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Read (
|
module Hledger.Read (
|
||||||
-- * Journal reading utilities
|
-- * Journal reading API
|
||||||
defaultJournalPath,
|
defaultJournalPath,
|
||||||
defaultJournal,
|
defaultJournal,
|
||||||
readJournal,
|
readJournal,
|
||||||
readJournalFile,
|
readJournalFile,
|
||||||
requireJournalFileExists,
|
requireJournalFileExists,
|
||||||
ensureJournalFileExists,
|
ensureJournalFileExists,
|
||||||
-- * Temporary parser exports for Convert
|
-- * Parsers used elsewhere
|
||||||
ledgeraccountname,
|
ledgeraccountname,
|
||||||
someamount,
|
someamount,
|
||||||
-- * Tests
|
-- * Tests
|
||||||
@ -89,12 +89,12 @@ readerForFormat s | null rs = Nothing
|
|||||||
where
|
where
|
||||||
rs = filter ((s==).rFormat) readers :: [Reader]
|
rs = filter ((s==).rFormat) readers :: [Reader]
|
||||||
|
|
||||||
-- | Read a Journal from this string or give an error message, using
|
-- | Read a Journal from this string or give an error message, using the
|
||||||
-- the specified data format or trying all known formats. CSV
|
-- specified data format or trying all known formats. A CSV conversion
|
||||||
-- conversion rules may be provided for better conversion of that
|
-- rules file may be specified for better conversion of that format,
|
||||||
-- format, and/or a file path for better error messages.
|
-- and/or a file path for better error messages.
|
||||||
readJournal :: Maybe Format -> Maybe ParseRules -> Maybe FilePath -> String -> IO (Either String Journal)
|
readJournal :: Maybe Format -> Maybe FilePath -> Maybe FilePath -> String -> IO (Either String Journal)
|
||||||
readJournal format rules path s =
|
readJournal format rulesfile path s =
|
||||||
let readerstotry = case format of Nothing -> readers
|
let readerstotry = case format of Nothing -> readers
|
||||||
Just f -> case readerForFormat f of Just r -> [r]
|
Just f -> case readerForFormat f of Just r -> [r]
|
||||||
Nothing -> []
|
Nothing -> []
|
||||||
@ -103,7 +103,7 @@ readJournal format rules path s =
|
|||||||
path' = fromMaybe "(string)" path
|
path' = fromMaybe "(string)" path
|
||||||
tryReader :: Reader -> IO (Either String Journal)
|
tryReader :: Reader -> IO (Either String Journal)
|
||||||
tryReader r = do -- printf "trying %s reader\n" (rFormat r)
|
tryReader r = do -- printf "trying %s reader\n" (rFormat r)
|
||||||
(runErrorT . (rParser r) rules path') s
|
(runErrorT . (rParser r) rulesfile path') s
|
||||||
|
|
||||||
-- if no reader succeeds, we return the error of the first;
|
-- if no reader succeeds, we return the error of the first;
|
||||||
-- ideally it would be the error of the most likely intended
|
-- ideally it would be the error of the most likely intended
|
||||||
@ -136,15 +136,15 @@ readJournal format rules path s =
|
|||||||
-- Nothing -> ""
|
-- Nothing -> ""
|
||||||
-- Just p -> " in "++p
|
-- Just p -> " in "++p
|
||||||
|
|
||||||
-- | Read a Journal from this file (or stdin if the filename is -) or
|
-- | Read a Journal from this file (or stdin if the filename is -) or give
|
||||||
-- give an error message, using the specified data format or trying
|
-- an error message, using the specified data format or trying all known
|
||||||
-- all known formats. CSV conversion rules may be provided for better
|
-- formats. A CSV conversion rules file may be specified for better
|
||||||
-- conversion of that format.
|
-- conversion of that format.
|
||||||
readJournalFile :: Maybe Format -> Maybe CsvReader.CsvRules -> FilePath -> IO (Either String Journal)
|
readJournalFile :: Maybe Format -> Maybe FilePath -> FilePath -> IO (Either String Journal)
|
||||||
readJournalFile format rules "-" = getContents >>= readJournal format rules (Just "(stdin)")
|
readJournalFile format rulesfile "-" = getContents >>= readJournal format rulesfile (Just "(stdin)")
|
||||||
readJournalFile format rules f = do
|
readJournalFile format rulesfile f = do
|
||||||
requireJournalFileExists f
|
requireJournalFileExists f
|
||||||
withFile f ReadMode $ \h -> hGetContents h >>= readJournal format rules (Just f)
|
withFile f ReadMode $ \h -> hGetContents h >>= readJournal format rulesfile (Just f)
|
||||||
|
|
||||||
-- | If the specified journal file does not exist, give a helpful error and quit.
|
-- | If the specified journal file does not exist, give a helpful error and quit.
|
||||||
requireJournalFileExists :: FilePath -> IO ()
|
requireJournalFileExists :: FilePath -> IO ()
|
||||||
|
|||||||
@ -1,72 +1,80 @@
|
|||||||
{-|
|
{-|
|
||||||
|
|
||||||
A reader for CSV files. Uses optional extra rules to help interpret the
|
A reader for the CSV data format. Uses an extra rules file
|
||||||
data, like the convert command.
|
(<http://hledger.org/MANUAL.html#rules-file-directives>) to help interpret
|
||||||
|
the data. Example:
|
||||||
|
|
||||||
|
@
|
||||||
|
\"2012\/3\/22\",\"something\",\"10.00\"
|
||||||
|
\"2012\/3\/23\",\"another\",\"5.50\"
|
||||||
|
@
|
||||||
|
|
||||||
|
and rules file:
|
||||||
|
|
||||||
|
@
|
||||||
|
date-field 0
|
||||||
|
description-field 1
|
||||||
|
amount-field 2
|
||||||
|
base-account assets:bank:checking
|
||||||
|
|
||||||
|
SAVINGS
|
||||||
|
assets:bank:savings
|
||||||
|
@
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Read.CsvReader (
|
module Hledger.Read.CsvReader (
|
||||||
CsvRules(..),
|
-- * Reader
|
||||||
nullrules,
|
|
||||||
reader,
|
reader,
|
||||||
|
-- * Tests
|
||||||
tests_Hledger_Read_CsvReader
|
tests_Hledger_Read_CsvReader
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Error
|
import Control.Monad.Error
|
||||||
import Test.HUnit
|
-- import Test.HUnit
|
||||||
-- import Text.ParserCombinators.Parsec hiding (parse)
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Ord
|
import Data.Ord
|
||||||
import Data.Time.Format (parseTime)
|
import Data.Time.Format (parseTime)
|
||||||
import Safe
|
import Safe
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
import System.Exit (exitFailure)
|
import System.FilePath
|
||||||
import System.FilePath (takeBaseName, replaceExtension)
|
|
||||||
import System.IO (stderr)
|
import System.IO (stderr)
|
||||||
import System.Locale (defaultTimeLocale)
|
import System.Locale (defaultTimeLocale)
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.CSV (parseCSV, parseCSVFromFile, CSV)
|
import Text.CSV (parseCSV, CSV)
|
||||||
import Text.ParserCombinators.Parsec
|
import Text.ParserCombinators.Parsec hiding (parse)
|
||||||
|
import Text.ParserCombinators.Parsec.Error
|
||||||
|
import Text.ParserCombinators.Parsec.Pos
|
||||||
import Text.Printf (hPrintf)
|
import Text.Printf (hPrintf)
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Read.Utils
|
|
||||||
import Prelude hiding (getContents)
|
import Prelude hiding (getContents)
|
||||||
import Hledger.Utils.UTF8 (getContents)
|
import Hledger.Utils.UTF8 (getContents)
|
||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
import Hledger.Data.FormatStrings as FormatStrings
|
import Hledger.Data.FormatStrings as FormatStrings
|
||||||
import Hledger.Read.JournalReader (ledgeraccountname, someamount)
|
import Hledger.Read.JournalReader (ledgeraccountname, someamount)
|
||||||
-- import Hledger.Read.JournalReader (ledgerDirective, ledgerHistoricalPrice,
|
|
||||||
-- ledgerDefaultYear, emptyLine, ledgerdatetime)
|
|
||||||
|
|
||||||
reader :: Reader
|
reader :: Reader
|
||||||
reader = Reader format detect parse_
|
reader = Reader format detect parse
|
||||||
|
|
||||||
format :: String
|
format :: String
|
||||||
format = "csv"
|
format = "csv"
|
||||||
|
|
||||||
-- | Does the given file path and data look like CSV ?
|
-- | Does the given file path and data look like CSV ?
|
||||||
detect :: FilePath -> String -> Bool
|
detect :: FilePath -> String -> Bool
|
||||||
detect f _ = fileSuffix f == format
|
detect f _ = takeExtension f == format
|
||||||
|
|
||||||
-- | Parse and post-process a "Journal" from CSV data, or give an error.
|
-- | Parse and post-process a "Journal" from CSV data, or give an error.
|
||||||
-- XXX currently ignores the string and reads from the file path
|
-- XXX currently ignores the string and reads from the file path
|
||||||
parse_ :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
|
parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal
|
||||||
parse_ rules f s = do
|
parse rulesfile f s = do
|
||||||
r <- liftIO $ journalFromCsv rules f s
|
r <- liftIO $ readJournalFromCsv rulesfile f s
|
||||||
case r of Left e -> throwError e
|
case r of Left e -> throwError e
|
||||||
Right j -> return j
|
Right j -> return j
|
||||||
|
|
||||||
-- csvFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
|
|
||||||
-- csvFile = do items <- many timelogItem
|
|
||||||
-- eof
|
|
||||||
-- ctx <- getState
|
|
||||||
-- return (liftM (foldr (.) id) $ sequence items, ctx)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
nullrules = CsvRules {
|
nullrules = CsvRules {
|
||||||
dateField=Nothing,
|
dateField=Nothing,
|
||||||
dateFormat=Nothing,
|
dateFormat=Nothing,
|
||||||
@ -88,32 +96,32 @@ nullrules = CsvRules {
|
|||||||
type CsvRecord = [String]
|
type CsvRecord = [String]
|
||||||
|
|
||||||
|
|
||||||
-- | Read the CSV file named as an argument and print equivalent journal transactions,
|
-- | Read a Journal or an error message from the given CSV data (and
|
||||||
-- using/creating a .rules file.
|
-- filename, used for error messages.) To do this we read a CSV
|
||||||
journalFromCsv :: Maybe CsvRules -> FilePath -> String -> IO (Either String Journal)
|
-- conversion rules file, or auto-create a default one if it does not
|
||||||
journalFromCsv csvrules csvfile content = do
|
-- exist. The rules filename may be specified, otherwise it will be
|
||||||
|
-- derived from the CSV filename (unless the filename is - in which case
|
||||||
|
-- an error will be raised.)
|
||||||
|
readJournalFromCsv :: Maybe FilePath -> FilePath -> String -> IO (Either String Journal)
|
||||||
|
readJournalFromCsv rulesfile csvfile csvdata = do
|
||||||
let usingStdin = csvfile == "-"
|
let usingStdin = csvfile == "-"
|
||||||
-- rulesFileSpecified = isJust $ rules_file_ opts
|
rulesfile' = case rulesfile of
|
||||||
-- when (usingStdin && (not rulesFileSpecified)) $ error' "please use --rules-file to specify a rules file when converting stdin"
|
Just f -> f
|
||||||
csvparse <- parseCsv csvfile content
|
Nothing -> if usingStdin
|
||||||
|
then error' "please use --rules-file to specify a rules file when converting stdin"
|
||||||
|
else rulesFileFor csvfile
|
||||||
|
created <- ensureRulesFileExists rulesfile'
|
||||||
|
if created
|
||||||
|
then hPrintf stderr "creating default conversion rules file %s, edit this file for better results\n" rulesfile'
|
||||||
|
else hPrintf stderr "using conversion rules file %s\n" rulesfile'
|
||||||
|
rules <- liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile'
|
||||||
|
|
||||||
|
|
||||||
|
csvparse <- parseCsv csvfile csvdata
|
||||||
let records = case csvparse of
|
let records = case csvparse of
|
||||||
Left e -> error' $ show e
|
Left e -> error' $ show e
|
||||||
Right rs -> filter (/= [""]) rs
|
Right rs -> filter (/= [""]) rs
|
||||||
rules <- case csvrules of
|
|
||||||
Nothing -> do
|
|
||||||
let rulesfile = rulesFileFor csvfile
|
|
||||||
exists <- doesFileExist rulesfile
|
|
||||||
if (not exists)
|
|
||||||
then do
|
|
||||||
hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile
|
|
||||||
writeFile rulesfile initialRulesFileContent
|
|
||||||
else
|
|
||||||
hPrintf stderr "using conversion rules file %s\n" rulesfile
|
|
||||||
liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile
|
|
||||||
Just r -> return r
|
|
||||||
let invalid = validateRules rules
|
|
||||||
-- when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules)
|
|
||||||
when (isJust invalid) $ error (fromJust invalid)
|
|
||||||
let requiredfields = max 2 (maxFieldIndex rules + 1)
|
let requiredfields = max 2 (maxFieldIndex rules + 1)
|
||||||
badrecords = take 1 $ filter ((< requiredfields).length) records
|
badrecords = take 1 $ filter ((< requiredfields).length) records
|
||||||
if null badrecords
|
if null badrecords
|
||||||
@ -127,11 +135,24 @@ journalFromCsv csvrules csvfile content = do
|
|||||||
, show $ head badrecords
|
, show $ head badrecords
|
||||||
])
|
])
|
||||||
|
|
||||||
|
-- | Ensure there is a conversion rules file at the given path, creating a
|
||||||
|
-- default one if needed and returning True in this case.
|
||||||
|
ensureRulesFileExists :: FilePath -> IO Bool
|
||||||
|
ensureRulesFileExists f = do
|
||||||
|
exists <- doesFileExist f
|
||||||
|
if exists
|
||||||
|
then return False
|
||||||
|
else do
|
||||||
|
-- note Hledger.Utils.UTF8.* do no line ending conversion on windows,
|
||||||
|
-- we currently require unix line endings on all platforms.
|
||||||
|
writeFile f newRulesFileContent
|
||||||
|
return True
|
||||||
|
|
||||||
parseCsv :: FilePath -> String -> IO (Either ParseError CSV)
|
parseCsv :: FilePath -> String -> IO (Either ParseError CSV)
|
||||||
parseCsv path content =
|
parseCsv path csvdata =
|
||||||
case path of
|
case path of
|
||||||
"-" -> liftM (parseCSV "(stdin)") getContents
|
"-" -> liftM (parseCSV "(stdin)") getContents
|
||||||
_ -> return $ parseCSV path content
|
_ -> return $ parseCSV path csvdata
|
||||||
|
|
||||||
-- | The highest (0-based) field index referenced in the field
|
-- | The highest (0-based) field index referenced in the field
|
||||||
-- definitions, or -1 if no fields are defined.
|
-- definitions, or -1 if no fields are defined.
|
||||||
@ -155,8 +176,8 @@ maxFieldIndex r = maximumDef (-1) $ catMaybes [
|
|||||||
rulesFileFor :: FilePath -> FilePath
|
rulesFileFor :: FilePath -> FilePath
|
||||||
rulesFileFor = flip replaceExtension ".rules"
|
rulesFileFor = flip replaceExtension ".rules"
|
||||||
|
|
||||||
initialRulesFileContent :: String
|
newRulesFileContent :: String
|
||||||
initialRulesFileContent = let prognameandversion = "hledger" in
|
newRulesFileContent = let prognameandversion = "hledger" in
|
||||||
"# csv conversion rules file generated by " ++ prognameandversion ++ "\n" ++
|
"# csv conversion rules file generated by " ++ prognameandversion ++ "\n" ++
|
||||||
"# Add rules to this file for more accurate conversion, see\n"++
|
"# Add rules to this file for more accurate conversion, see\n"++
|
||||||
"# http://hledger.org/MANUAL.html#convert\n" ++
|
"# http://hledger.org/MANUAL.html#convert\n" ++
|
||||||
@ -179,25 +200,19 @@ initialRulesFileContent = let prognameandversion = "hledger" in
|
|||||||
"(TO|FROM) SAVINGS\n" ++
|
"(TO|FROM) SAVINGS\n" ++
|
||||||
"assets:bank:savings\n"
|
"assets:bank:savings\n"
|
||||||
|
|
||||||
validateRules :: CsvRules -> Maybe String
|
|
||||||
validateRules rules = let
|
|
||||||
hasAmount = isJust $ amountField rules
|
|
||||||
hasIn = isJust $ amountInField rules
|
|
||||||
hasOut = isJust $ amountOutField rules
|
|
||||||
in case (hasAmount, hasIn, hasOut) of
|
|
||||||
(True, True, _) -> Just "Don't specify amount-in-field when specifying amount-field"
|
|
||||||
(True, _, True) -> Just "Don't specify amount-out-field when specifying amount-field"
|
|
||||||
(_, False, True) -> Just "Please specify amount-in-field when specifying amount-out-field"
|
|
||||||
(_, True, False) -> Just "Please specify amount-out-field when specifying amount-in-field"
|
|
||||||
(False, False, False) -> Just "Please specify either amount-field, or amount-in-field and amount-out-field"
|
|
||||||
_ -> Nothing
|
|
||||||
|
|
||||||
-- rules file parser
|
-- rules file parser
|
||||||
|
|
||||||
parseCsvRulesFile :: FilePath -> IO (Either ParseError CsvRules)
|
parseCsvRulesFile :: FilePath -> IO (Either ParseError CsvRules)
|
||||||
parseCsvRulesFile f = do
|
parseCsvRulesFile f = do
|
||||||
s <- readFile f
|
s <- readFile f
|
||||||
return $ parseCsvRules f s
|
let rules = parseCsvRules f s
|
||||||
|
return $ case rules of
|
||||||
|
Left e -> Left e
|
||||||
|
Right r -> case validateRules r of
|
||||||
|
Left e -> Left $ toParseError e
|
||||||
|
Right r -> Right r
|
||||||
|
where
|
||||||
|
toParseError s = newErrorMessage (Message s) (initialPos "")
|
||||||
|
|
||||||
parseCsvRules :: FilePath -> String -> Either ParseError CsvRules
|
parseCsvRules :: FilePath -> String -> Either ParseError CsvRules
|
||||||
parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
|
parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
|
||||||
@ -339,8 +354,6 @@ accountrule = do
|
|||||||
return (pats',acct)
|
return (pats',acct)
|
||||||
<?> "account rule"
|
<?> "account rule"
|
||||||
|
|
||||||
blanklines = many1 blankline
|
|
||||||
|
|
||||||
blankline = many spacenonewline >> newline >> return () <?> "blank line"
|
blankline = many spacenonewline >> newline >> return () <?> "blank line"
|
||||||
|
|
||||||
commentchar = oneOf ";#"
|
commentchar = oneOf ";#"
|
||||||
@ -356,6 +369,19 @@ matchreplacepattern = do
|
|||||||
newline
|
newline
|
||||||
return (matchpat,replpat)
|
return (matchpat,replpat)
|
||||||
|
|
||||||
|
validateRules :: CsvRules -> Either String CsvRules
|
||||||
|
validateRules rules =
|
||||||
|
let hasAmount = isJust $ amountField rules
|
||||||
|
hasIn = isJust $ amountInField rules
|
||||||
|
hasOut = isJust $ amountOutField rules
|
||||||
|
in case (hasAmount, hasIn, hasOut) of
|
||||||
|
(True, True, _) -> Left "Don't specify amount-in-field when specifying amount-field"
|
||||||
|
(True, _, True) -> Left "Don't specify amount-out-field when specifying amount-field"
|
||||||
|
(_, False, True) -> Left "Please specify amount-in-field when specifying amount-out-field"
|
||||||
|
(_, True, False) -> Left "Please specify amount-out-field when specifying amount-in-field"
|
||||||
|
(False, False, False) -> Left "Please specify either amount-field, or amount-in-field and amount-out-field"
|
||||||
|
_ -> Right rules
|
||||||
|
|
||||||
-- csv record conversion
|
-- csv record conversion
|
||||||
formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String
|
formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String
|
||||||
formatD record leftJustified min max f = case f of
|
formatD record leftJustified min max f = case f of
|
||||||
@ -483,8 +509,6 @@ identify rules defacct desc | null matchingrules = (defacct,desc)
|
|||||||
newdesc = case r of Just repl -> regexReplaceCI p repl desc
|
newdesc = case r of Just repl -> regexReplaceCI p repl desc
|
||||||
Nothing -> desc
|
Nothing -> desc
|
||||||
|
|
||||||
caseinsensitive = ("(?i)"++)
|
|
||||||
|
|
||||||
getAmount :: CsvRules -> CsvRecord -> String
|
getAmount :: CsvRules -> CsvRecord -> String
|
||||||
getAmount rules fields = case amountField rules of
|
getAmount rules fields = case amountField rules of
|
||||||
Just f -> maybe "" (atDef "" fields) $ Just f
|
Just f -> maybe "" (atDef "" fields) $ Just f
|
||||||
|
|||||||
@ -1,118 +1,35 @@
|
|||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
A reader for hledger's (and c++ ledger's) journal file format.
|
A reader for hledger's journal file format
|
||||||
|
(<http://hledger.org/MANUAL.html#the-journal-file>). hledger's journal
|
||||||
From the ledger 2.5 manual:
|
format is a compatible subset of c++ ledger's
|
||||||
|
(<http://ledger-cli.org/3.0/doc/ledger3.html#Journal-Format>), so this
|
||||||
|
reader should handle many ledger files as well. Example:
|
||||||
|
|
||||||
@
|
@
|
||||||
The ledger file format is quite simple, but also very flexible. It supports
|
2012\/3\/24 gift
|
||||||
many options, though typically the user can ignore most of them. They are
|
expenses:gifts $10
|
||||||
summarized below. The initial character of each line determines what the
|
assets:cash
|
||||||
line means, and how it should be interpreted. Allowable initial characters
|
|
||||||
are:
|
|
||||||
|
|
||||||
NUMBER A line beginning with a number denotes an entry. It may be followed by any
|
|
||||||
number of lines, each beginning with whitespace, to denote the entry’s account
|
|
||||||
transactions. The format of the first line is:
|
|
||||||
|
|
||||||
DATE[=EDATE] [*|!] [(CODE)] DESC
|
|
||||||
|
|
||||||
If ‘*’ appears after the date (with optional effective date), it indicates the entry
|
|
||||||
is “cleared”, which can mean whatever the user wants it t omean. If ‘!’ appears
|
|
||||||
after the date, it indicates d the entry is “pending”; i.e., tentatively cleared from
|
|
||||||
the user’s point of view, but not yet actually cleared. If a ‘CODE’ appears in
|
|
||||||
parentheses, it may be used to indicate a check number, or the type of the
|
|
||||||
transaction. Following these is the payee, or a description of the transaction.
|
|
||||||
The format of each following transaction is:
|
|
||||||
|
|
||||||
ACCOUNT AMOUNT [; NOTE]
|
|
||||||
|
|
||||||
The ‘ACCOUNT’ may be surrounded by parentheses if it is a virtual
|
|
||||||
transactions, or square brackets if it is a virtual transactions that must
|
|
||||||
balance. The ‘AMOUNT’ can be followed by a per-unit transaction cost,
|
|
||||||
by specifying ‘ AMOUNT’, or a complete transaction cost with ‘\@ AMOUNT’.
|
|
||||||
Lastly, the ‘NOTE’ may specify an actual and/or effective date for the
|
|
||||||
transaction by using the syntax ‘[ACTUAL_DATE]’ or ‘[=EFFECTIVE_DATE]’ or
|
|
||||||
‘[ACTUAL_DATE=EFFECtIVE_DATE]’.
|
|
||||||
|
|
||||||
= An automated entry. A value expression must appear after the equal sign.
|
|
||||||
After this initial line there should be a set of one or more transactions, just as
|
|
||||||
if it were normal entry. If the amounts of the transactions have no commodity,
|
|
||||||
they will be applied as modifiers to whichever real transaction is matched by
|
|
||||||
the value expression.
|
|
||||||
|
|
||||||
~ A period entry. A period expression must appear after the tilde.
|
|
||||||
After this initial line there should be a set of one or more transactions, just as
|
|
||||||
if it were normal entry.
|
|
||||||
|
|
||||||
! A line beginning with an exclamation mark denotes a command directive. It
|
|
||||||
must be immediately followed by the command word. The supported commands
|
|
||||||
are:
|
|
||||||
|
|
||||||
‘!include’
|
|
||||||
Include the stated ledger file.
|
|
||||||
‘!account’
|
|
||||||
The account name is given is taken to be the parent of all transac-
|
|
||||||
tions that follow, until ‘!end’ is seen.
|
|
||||||
‘!end’ Ends an account block.
|
|
||||||
|
|
||||||
; A line beginning with a colon indicates a comment, and is ignored.
|
|
||||||
|
|
||||||
Y If a line begins with a capital Y, it denotes the year used for all subsequent
|
|
||||||
entries that give a date without a year. The year should appear immediately
|
|
||||||
after the Y, for example: ‘Y2004’. This is useful at the beginning of a file, to
|
|
||||||
specify the year for that file. If all entries specify a year, however, this command
|
|
||||||
has no effect.
|
|
||||||
|
|
||||||
|
|
||||||
P Specifies a historical price for a commodity. These are usually found in a pricing
|
|
||||||
history file (see the ‘-Q’ option). The syntax is:
|
|
||||||
|
|
||||||
P DATE SYMBOL PRICE
|
|
||||||
|
|
||||||
N SYMBOL Indicates that pricing information is to be ignored for a given symbol, nor will
|
|
||||||
quotes ever be downloaded for that symbol. Useful with a home currency, such
|
|
||||||
as the dollar ($). It is recommended that these pricing options be set in the price
|
|
||||||
database file, which defaults to ‘~/.pricedb’. The syntax for this command is:
|
|
||||||
|
|
||||||
N SYMBOL
|
|
||||||
|
|
||||||
|
|
||||||
D AMOUNT Specifies the default commodity to use, by specifying an amount in the expected
|
|
||||||
format. The entry command will use this commodity as the default when none
|
|
||||||
other can be determined. This command may be used multiple times, to set
|
|
||||||
the default flags for different commodities; whichever is seen last is used as the
|
|
||||||
default commodity. For example, to set US dollars as the default commodity,
|
|
||||||
while also setting the thousands flag and decimal flag for that commodity, use:
|
|
||||||
|
|
||||||
D $1,000.00
|
|
||||||
|
|
||||||
C AMOUNT1 = AMOUNT2
|
|
||||||
Specifies a commodity conversion, where the first amount is given to be equiv-
|
|
||||||
alent to the second amount. The first amount should use the decimal precision
|
|
||||||
desired during reporting:
|
|
||||||
|
|
||||||
C 1.00 Kb = 1024 bytes
|
|
||||||
|
|
||||||
i, o, b, h
|
|
||||||
These four relate to timeclock support, which permits ledger to read timelog
|
|
||||||
files. See the timeclock’s documentation for more info on the syntax of its
|
|
||||||
timelog files.
|
|
||||||
@
|
@
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Read.JournalReader (
|
module Hledger.Read.JournalReader (
|
||||||
|
-- * Reader
|
||||||
|
reader,
|
||||||
|
-- * Parsers used elsewhere
|
||||||
emptyLine,
|
emptyLine,
|
||||||
journalAddFile,
|
|
||||||
journalFile,
|
journalFile,
|
||||||
ledgeraccountname,
|
ledgeraccountname,
|
||||||
ledgerdatetime,
|
ledgerdatetime,
|
||||||
ledgerDefaultYear,
|
ledgerDefaultYear,
|
||||||
ledgerDirective,
|
ledgerDirective,
|
||||||
ledgerHistoricalPrice,
|
ledgerHistoricalPrice,
|
||||||
reader,
|
|
||||||
someamount,
|
someamount,
|
||||||
|
parseJournalWith,
|
||||||
|
getParentAccount,
|
||||||
|
-- * Tests
|
||||||
tests_Hledger_Read_JournalReader
|
tests_Hledger_Read_JournalReader
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
@ -131,9 +48,10 @@ import Safe (headDef)
|
|||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.ParserCombinators.Parsec hiding (parse)
|
import Text.ParserCombinators.Parsec hiding (parse)
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
|
import System.FilePath
|
||||||
|
import System.Time (getClockTime)
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Read.Utils
|
|
||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
import Prelude hiding (readFile)
|
import Prelude hiding (readFile)
|
||||||
import Hledger.Utils.UTF8 (readFile)
|
import Hledger.Utils.UTF8 (readFile)
|
||||||
@ -149,13 +67,70 @@ format = "journal"
|
|||||||
|
|
||||||
-- | Does the given file path and data provide hledger's journal file format ?
|
-- | Does the given file path and data provide hledger's journal file format ?
|
||||||
detect :: FilePath -> String -> Bool
|
detect :: FilePath -> String -> Bool
|
||||||
detect f _ = fileSuffix f == format
|
detect f _ = takeExtension f == format
|
||||||
|
|
||||||
-- | Parse and post-process a "Journal" from hledger's journal file
|
-- | Parse and post-process a "Journal" from hledger's journal file
|
||||||
-- format, or give an error.
|
-- format, or give an error.
|
||||||
parse :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
|
parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal
|
||||||
parse _ = parseJournalWith journalFile
|
parse _ = parseJournalWith journalFile
|
||||||
|
|
||||||
|
-- parsing utils
|
||||||
|
|
||||||
|
-- | Flatten a list of JournalUpdate's into a single equivalent one.
|
||||||
|
combineJournalUpdates :: [JournalUpdate] -> JournalUpdate
|
||||||
|
combineJournalUpdates us = liftM (foldr (.) id) $ sequence us
|
||||||
|
|
||||||
|
-- | Given a JournalUpdate-generating parsec parser, file path and data string,
|
||||||
|
-- parse and post-process a Journal so that it's ready to use, or give an error.
|
||||||
|
parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> FilePath -> String -> ErrorT String IO Journal
|
||||||
|
parseJournalWith p f s = do
|
||||||
|
tc <- liftIO getClockTime
|
||||||
|
tl <- liftIO getCurrentLocalTime
|
||||||
|
y <- liftIO getCurrentYear
|
||||||
|
case runParser p nullctx{ctxYear=Just y} f s of
|
||||||
|
Right (updates,ctx) -> do
|
||||||
|
j <- updates `ap` return nulljournal
|
||||||
|
case journalFinalise tc tl f s ctx j of
|
||||||
|
Right j' -> return j'
|
||||||
|
Left estr -> throwError estr
|
||||||
|
Left e -> throwError $ show e
|
||||||
|
|
||||||
|
setYear :: Integer -> GenParser tok JournalContext ()
|
||||||
|
setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
|
||||||
|
|
||||||
|
getYear :: GenParser tok JournalContext (Maybe Integer)
|
||||||
|
getYear = liftM ctxYear getState
|
||||||
|
|
||||||
|
setCommodity :: Commodity -> GenParser tok JournalContext ()
|
||||||
|
setCommodity c = updateState (\ctx -> ctx{ctxCommodity=Just c})
|
||||||
|
|
||||||
|
getCommodity :: GenParser tok JournalContext (Maybe Commodity)
|
||||||
|
getCommodity = liftM ctxCommodity getState
|
||||||
|
|
||||||
|
pushParentAccount :: String -> GenParser tok JournalContext ()
|
||||||
|
pushParentAccount parent = updateState addParentAccount
|
||||||
|
where addParentAccount ctx0 = ctx0 { ctxAccount = parent : ctxAccount ctx0 }
|
||||||
|
|
||||||
|
popParentAccount :: GenParser tok JournalContext ()
|
||||||
|
popParentAccount = do ctx0 <- getState
|
||||||
|
case ctxAccount ctx0 of
|
||||||
|
[] -> unexpected "End of account block with no beginning"
|
||||||
|
(_:rest) -> setState $ ctx0 { ctxAccount = rest }
|
||||||
|
|
||||||
|
getParentAccount :: GenParser tok JournalContext String
|
||||||
|
getParentAccount = liftM (concatAccountNames . reverse . ctxAccount) getState
|
||||||
|
|
||||||
|
addAccountAlias :: (AccountName,AccountName) -> GenParser tok JournalContext ()
|
||||||
|
addAccountAlias a = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases})
|
||||||
|
|
||||||
|
getAccountAliases :: GenParser tok JournalContext [(AccountName,AccountName)]
|
||||||
|
getAccountAliases = liftM ctxAliases getState
|
||||||
|
|
||||||
|
clearAccountAliases :: GenParser tok JournalContext ()
|
||||||
|
clearAccountAliases = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]})
|
||||||
|
|
||||||
|
--
|
||||||
|
|
||||||
-- | Top-level journal parser. Returns a single composite, I/O performing,
|
-- | Top-level journal parser. Returns a single composite, I/O performing,
|
||||||
-- error-raising "JournalUpdate" (and final "JournalContext") which can be
|
-- error-raising "JournalUpdate" (and final "JournalContext") which can be
|
||||||
-- applied to an empty journal to get the final result.
|
-- applied to an empty journal to get the final result.
|
||||||
@ -164,7 +139,7 @@ journalFile = do
|
|||||||
journalupdates <- many journalItem
|
journalupdates <- many journalItem
|
||||||
eof
|
eof
|
||||||
finalctx <- getState
|
finalctx <- getState
|
||||||
return $ (juSequence journalupdates, finalctx)
|
return $ (combineJournalUpdates journalupdates, finalctx)
|
||||||
where
|
where
|
||||||
-- As all journal line types can be distinguished by the first
|
-- As all journal line types can be distinguished by the first
|
||||||
-- character, excepting transactions versus empty (blank or
|
-- character, excepting transactions versus empty (blank or
|
||||||
@ -228,7 +203,7 @@ ledgerInclude = do
|
|||||||
txt <- readFileOrError outerPos filepath
|
txt <- readFileOrError outerPos filepath
|
||||||
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
|
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
|
||||||
case runParser journalFile outerState filepath txt of
|
case runParser journalFile outerState filepath txt of
|
||||||
Right (ju,_) -> juSequence [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))
|
Right (ju,_) -> combineJournalUpdates [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))
|
||||||
Left err -> throwError $ inIncluded ++ show err
|
Left err -> throwError $ inIncluded ++ show err
|
||||||
where readFileOrError pos fp =
|
where readFileOrError pos fp =
|
||||||
ErrorT $ liftM Right (readFile fp) `catch`
|
ErrorT $ liftM Right (readFile fp) `catch`
|
||||||
|
|||||||
@ -1,6 +1,12 @@
|
|||||||
{-|
|
{-|
|
||||||
|
|
||||||
A reader for the timelog file format generated by timeclock.el.
|
A reader for the timelog file format generated by timeclock.el
|
||||||
|
(<http://www.emacswiki.org/emacs/TimeClock>). Example:
|
||||||
|
|
||||||
|
@
|
||||||
|
i 2007\/03\/10 12:26:00 hledger
|
||||||
|
o 2007\/03\/10 17:26:02
|
||||||
|
@
|
||||||
|
|
||||||
From timeclock.el 2.6:
|
From timeclock.el 2.6:
|
||||||
|
|
||||||
@ -32,17 +38,12 @@ i, o or O. The meanings of the codes are:
|
|||||||
now finished. Useful for creating summary reports.
|
now finished. Useful for creating summary reports.
|
||||||
@
|
@
|
||||||
|
|
||||||
Example:
|
|
||||||
|
|
||||||
@
|
|
||||||
i 2007/03/10 12:26:00 hledger
|
|
||||||
o 2007/03/10 17:26:02
|
|
||||||
@
|
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Read.TimelogReader (
|
module Hledger.Read.TimelogReader (
|
||||||
|
-- * Reader
|
||||||
reader,
|
reader,
|
||||||
|
-- * Tests
|
||||||
tests_Hledger_Read_TimelogReader
|
tests_Hledger_Read_TimelogReader
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
@ -50,11 +51,13 @@ import Control.Monad
|
|||||||
import Control.Monad.Error
|
import Control.Monad.Error
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.ParserCombinators.Parsec hiding (parse)
|
import Text.ParserCombinators.Parsec hiding (parse)
|
||||||
|
import System.FilePath
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Read.Utils
|
import Hledger.Read.JournalReader (
|
||||||
import Hledger.Read.JournalReader (ledgerDirective, ledgerHistoricalPrice,
|
ledgerDirective, ledgerHistoricalPrice, ledgerDefaultYear, emptyLine, ledgerdatetime,
|
||||||
ledgerDefaultYear, emptyLine, ledgerdatetime)
|
parseJournalWith, getParentAccount
|
||||||
|
)
|
||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
|
|
||||||
|
|
||||||
@ -66,12 +69,12 @@ format = "timelog"
|
|||||||
|
|
||||||
-- | Does the given file path and data provide timeclock.el's timelog format ?
|
-- | Does the given file path and data provide timeclock.el's timelog format ?
|
||||||
detect :: FilePath -> String -> Bool
|
detect :: FilePath -> String -> Bool
|
||||||
detect f _ = fileSuffix f == format
|
detect f _ = takeExtension f == format
|
||||||
|
|
||||||
-- | Parse and post-process a "Journal" from timeclock.el's timelog
|
-- | Parse and post-process a "Journal" from timeclock.el's timelog
|
||||||
-- format, saving the provided file path and the current time, or give an
|
-- format, saving the provided file path and the current time, or give an
|
||||||
-- error.
|
-- error.
|
||||||
parse :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
|
parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal
|
||||||
parse _ = parseJournalWith timelogFile
|
parse _ = parseJournalWith timelogFile
|
||||||
|
|
||||||
timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
|
timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
|
||||||
|
|||||||
@ -1,88 +0,0 @@
|
|||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
{-|
|
|
||||||
|
|
||||||
Utilities used throughout hledger's read system.
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
module Hledger.Read.Utils
|
|
||||||
where
|
|
||||||
|
|
||||||
import Control.Monad.Error
|
|
||||||
import Data.List
|
|
||||||
import System.Directory (getHomeDirectory)
|
|
||||||
import System.FilePath(takeDirectory,combine)
|
|
||||||
import System.Time (getClockTime)
|
|
||||||
import Text.ParserCombinators.Parsec
|
|
||||||
|
|
||||||
import Hledger.Data.Types
|
|
||||||
import Hledger.Utils
|
|
||||||
import Hledger.Data.Posting
|
|
||||||
import Hledger.Data.Dates (getCurrentYear)
|
|
||||||
import Hledger.Data.Journal
|
|
||||||
|
|
||||||
|
|
||||||
juSequence :: [JournalUpdate] -> JournalUpdate
|
|
||||||
juSequence us = liftM (foldr (.) id) $ sequence us
|
|
||||||
|
|
||||||
-- | Given a JournalUpdate-generating parsec parser, file path and data string,
|
|
||||||
-- parse and post-process a Journal so that it's ready to use, or give an error.
|
|
||||||
parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> FilePath -> String -> ErrorT String IO Journal
|
|
||||||
parseJournalWith p f s = do
|
|
||||||
tc <- liftIO getClockTime
|
|
||||||
tl <- liftIO getCurrentLocalTime
|
|
||||||
y <- liftIO getCurrentYear
|
|
||||||
case runParser p nullctx{ctxYear=Just y} f s of
|
|
||||||
Right (updates,ctx) -> do
|
|
||||||
j <- updates `ap` return nulljournal
|
|
||||||
case journalFinalise tc tl f s ctx j of
|
|
||||||
Right j' -> return j'
|
|
||||||
Left estr -> throwError estr
|
|
||||||
Left e -> throwError $ show e
|
|
||||||
|
|
||||||
setYear :: Integer -> GenParser tok JournalContext ()
|
|
||||||
setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
|
|
||||||
|
|
||||||
getYear :: GenParser tok JournalContext (Maybe Integer)
|
|
||||||
getYear = liftM ctxYear getState
|
|
||||||
|
|
||||||
setCommodity :: Commodity -> GenParser tok JournalContext ()
|
|
||||||
setCommodity c = updateState (\ctx -> ctx{ctxCommodity=Just c})
|
|
||||||
|
|
||||||
getCommodity :: GenParser tok JournalContext (Maybe Commodity)
|
|
||||||
getCommodity = liftM ctxCommodity getState
|
|
||||||
|
|
||||||
pushParentAccount :: String -> GenParser tok JournalContext ()
|
|
||||||
pushParentAccount parent = updateState addParentAccount
|
|
||||||
where addParentAccount ctx0 = ctx0 { ctxAccount = parent : ctxAccount ctx0 }
|
|
||||||
|
|
||||||
popParentAccount :: GenParser tok JournalContext ()
|
|
||||||
popParentAccount = do ctx0 <- getState
|
|
||||||
case ctxAccount ctx0 of
|
|
||||||
[] -> unexpected "End of account block with no beginning"
|
|
||||||
(_:rest) -> setState $ ctx0 { ctxAccount = rest }
|
|
||||||
|
|
||||||
getParentAccount :: GenParser tok JournalContext String
|
|
||||||
getParentAccount = liftM (concatAccountNames . reverse . ctxAccount) getState
|
|
||||||
|
|
||||||
addAccountAlias :: (AccountName,AccountName) -> GenParser tok JournalContext ()
|
|
||||||
addAccountAlias a = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases})
|
|
||||||
|
|
||||||
getAccountAliases :: GenParser tok JournalContext [(AccountName,AccountName)]
|
|
||||||
getAccountAliases = liftM ctxAliases getState
|
|
||||||
|
|
||||||
clearAccountAliases :: GenParser tok JournalContext ()
|
|
||||||
clearAccountAliases = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]})
|
|
||||||
|
|
||||||
-- | 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)
|
|
||||||
where
|
|
||||||
mkAbsolute = combine (takeDirectory (sourceName pos))
|
|
||||||
expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory
|
|
||||||
return $ homedir ++ drop 1 inname
|
|
||||||
| otherwise = return inname
|
|
||||||
|
|
||||||
fileSuffix :: FilePath -> String
|
|
||||||
fileSuffix = reverse . takeWhile (/='.') . reverse . dropWhile (/='.')
|
|
||||||
@ -25,6 +25,7 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded)
|
import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded)
|
||||||
|
import Control.Monad.Error
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
@ -32,6 +33,8 @@ import Data.Time.Clock
|
|||||||
import Data.Time.LocalTime
|
import Data.Time.LocalTime
|
||||||
import Data.Tree
|
import Data.Tree
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
import System.Directory (getHomeDirectory)
|
||||||
|
import System.FilePath(takeDirectory,combine)
|
||||||
import System.Info (os)
|
import System.Info (os)
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.ParserCombinators.Parsec
|
import Text.ParserCombinators.Parsec
|
||||||
@ -425,3 +428,13 @@ isRight = not . isLeft
|
|||||||
-- | Apply a function the specified number of times. Possibly uses O(n) stack ?
|
-- | Apply a function the specified number of times. Possibly uses O(n) stack ?
|
||||||
applyN :: Int -> (a -> a) -> a -> a
|
applyN :: Int -> (a -> a) -> a -> a
|
||||||
applyN n f = (!! n) . iterate f
|
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)
|
||||||
|
where
|
||||||
|
mkAbsolute = combine (takeDirectory (sourceName pos))
|
||||||
|
expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory
|
||||||
|
return $ homedir ++ drop 1 inname
|
||||||
|
| otherwise = return inname
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user