diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 34f841667..ea8f6f13f 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -183,8 +183,8 @@ data Reader = Reader { rFormat :: Format -- quickly check if this reader can probably handle the given file path and file content ,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 - ,rParser :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal + -- 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 FilePath -> FilePath -> String -> ErrorT String IO Journal } -- data format parse/conversion rules diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 2020dd43b..fb97a0363 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -1,21 +1,21 @@ {-| 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 -parse journal data or read journal files; it should not be necessary +Journals from various data formats. Use this module if you want to parse +journal data or read journal files. Generally it should not be necessary to import modules below this one. -} module Hledger.Read ( - -- * Journal reading utilities + -- * Journal reading API defaultJournalPath, defaultJournal, readJournal, readJournalFile, requireJournalFileExists, ensureJournalFileExists, - -- * Temporary parser exports for Convert + -- * Parsers used elsewhere ledgeraccountname, someamount, -- * Tests @@ -89,12 +89,12 @@ readerForFormat s | null rs = Nothing where rs = filter ((s==).rFormat) readers :: [Reader] --- | Read a Journal from this string or give an error message, using --- the specified data format or trying all known formats. CSV --- conversion rules may be provided for better conversion of that --- format, and/or a file path for better error messages. -readJournal :: Maybe Format -> Maybe ParseRules -> Maybe FilePath -> String -> IO (Either String Journal) -readJournal format rules path s = +-- | Read a Journal from this string or give an error message, using the +-- specified data format or trying all known formats. A CSV conversion +-- rules file may be specified for better conversion of that format, +-- and/or a file path for better error messages. +readJournal :: Maybe Format -> Maybe FilePath -> Maybe FilePath -> String -> IO (Either String Journal) +readJournal format rulesfile path s = let readerstotry = case format of Nothing -> readers Just f -> case readerForFormat f of Just r -> [r] Nothing -> [] @@ -103,7 +103,7 @@ readJournal format rules path s = path' = fromMaybe "(string)" path tryReader :: Reader -> IO (Either String Journal) 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; -- ideally it would be the error of the most likely intended @@ -136,15 +136,15 @@ readJournal format rules path s = -- Nothing -> "" -- Just p -> " in "++p --- | Read a Journal from this file (or stdin if the filename is -) or --- give an error message, using the specified data format or trying --- all known formats. CSV conversion rules may be provided for better +-- | Read a Journal from this file (or stdin if the filename is -) or give +-- an error message, using the specified data format or trying all known +-- formats. A CSV conversion rules file may be specified for better -- conversion of that format. -readJournalFile :: Maybe Format -> Maybe CsvReader.CsvRules -> FilePath -> IO (Either String Journal) -readJournalFile format rules "-" = getContents >>= readJournal format rules (Just "(stdin)") -readJournalFile format rules f = do +readJournalFile :: Maybe Format -> Maybe FilePath -> FilePath -> IO (Either String Journal) +readJournalFile format rulesfile "-" = getContents >>= readJournal format rulesfile (Just "(stdin)") +readJournalFile format rulesfile f = do 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. requireJournalFileExists :: FilePath -> IO () diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index f7e99ef08..e88085f9f 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -1,72 +1,80 @@ {-| -A reader for CSV files. Uses optional extra rules to help interpret the -data, like the convert command. +A reader for the CSV data format. Uses an extra rules file +() 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 ( - CsvRules(..), - nullrules, + -- * Reader reader, + -- * Tests tests_Hledger_Read_CsvReader ) where import Control.Monad import Control.Monad.Error -import Test.HUnit --- import Text.ParserCombinators.Parsec hiding (parse) +-- import Test.HUnit import Data.List import Data.Maybe import Data.Ord import Data.Time.Format (parseTime) import Safe import System.Directory (doesFileExist) -import System.Exit (exitFailure) -import System.FilePath (takeBaseName, replaceExtension) +import System.FilePath import System.IO (stderr) import System.Locale (defaultTimeLocale) import Test.HUnit -import Text.CSV (parseCSV, parseCSVFromFile, CSV) -import Text.ParserCombinators.Parsec +import Text.CSV (parseCSV, CSV) +import Text.ParserCombinators.Parsec hiding (parse) +import Text.ParserCombinators.Parsec.Error +import Text.ParserCombinators.Parsec.Pos import Text.Printf (hPrintf) import Hledger.Data -import Hledger.Read.Utils import Prelude hiding (getContents) import Hledger.Utils.UTF8 (getContents) import Hledger.Utils import Hledger.Data.FormatStrings as FormatStrings import Hledger.Read.JournalReader (ledgeraccountname, someamount) --- import Hledger.Read.JournalReader (ledgerDirective, ledgerHistoricalPrice, --- ledgerDefaultYear, emptyLine, ledgerdatetime) + reader :: Reader -reader = Reader format detect parse_ +reader = Reader format detect parse format :: String format = "csv" -- | Does the given file path and data look like CSV ? 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. -- XXX currently ignores the string and reads from the file path -parse_ :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal -parse_ rules f s = do - r <- liftIO $ journalFromCsv rules f s +parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal +parse rulesfile f s = do + r <- liftIO $ readJournalFromCsv rulesfile f s case r of Left e -> throwError e 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 { dateField=Nothing, dateFormat=Nothing, @@ -88,32 +96,32 @@ nullrules = CsvRules { type CsvRecord = [String] --- | Read the CSV file named as an argument and print equivalent journal transactions, --- using/creating a .rules file. -journalFromCsv :: Maybe CsvRules -> FilePath -> String -> IO (Either String Journal) -journalFromCsv csvrules csvfile content = do +-- | Read a Journal or an error message from the given CSV data (and +-- filename, used for error messages.) To do this we read a CSV +-- conversion rules file, or auto-create a default one if it does not +-- 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 == "-" - -- rulesFileSpecified = isJust $ rules_file_ opts - -- when (usingStdin && (not rulesFileSpecified)) $ error' "please use --rules-file to specify a rules file when converting stdin" - csvparse <- parseCsv csvfile content + rulesfile' = case rulesfile of + Just f -> f + 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 Left e -> error' $ show e 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) badrecords = take 1 $ filter ((< requiredfields).length) records if null badrecords @@ -127,11 +135,24 @@ journalFromCsv csvrules csvfile content = do , 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 path content = +parseCsv path csvdata = case path of "-" -> liftM (parseCSV "(stdin)") getContents - _ -> return $ parseCSV path content + _ -> return $ parseCSV path csvdata -- | The highest (0-based) field index referenced in the field -- definitions, or -1 if no fields are defined. @@ -155,8 +176,8 @@ maxFieldIndex r = maximumDef (-1) $ catMaybes [ rulesFileFor :: FilePath -> FilePath rulesFileFor = flip replaceExtension ".rules" -initialRulesFileContent :: String -initialRulesFileContent = let prognameandversion = "hledger" in +newRulesFileContent :: String +newRulesFileContent = let prognameandversion = "hledger" in "# csv conversion rules file generated by " ++ prognameandversion ++ "\n" ++ "# Add rules to this file for more accurate conversion, see\n"++ "# http://hledger.org/MANUAL.html#convert\n" ++ @@ -179,25 +200,19 @@ initialRulesFileContent = let prognameandversion = "hledger" in "(TO|FROM) 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 parseCsvRulesFile :: FilePath -> IO (Either ParseError CsvRules) parseCsvRulesFile f = do 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 rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s @@ -339,8 +354,6 @@ accountrule = do return (pats',acct) "account rule" -blanklines = many1 blankline - blankline = many spacenonewline >> newline >> return () "blank line" commentchar = oneOf ";#" @@ -356,6 +369,19 @@ matchreplacepattern = do newline 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 formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String 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 Nothing -> desc -caseinsensitive = ("(?i)"++) - getAmount :: CsvRules -> CsvRecord -> String getAmount rules fields = case amountField rules of Just f -> maybe "" (atDef "" fields) $ Just f diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 144e99a65..82b402e22 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -1,119 +1,36 @@ +{-# LANGUAGE RecordWildCards #-} {-| -A reader for hledger's (and c++ ledger's) journal file format. - -From the ledger 2.5 manual: +A reader for hledger's journal file format +(). hledger's journal +format is a compatible subset of c++ ledger's +(), so this +reader should handle many ledger files as well. Example: @ -The ledger file format is quite simple, but also very flexible. It supports -many options, though typically the user can ignore most of them. They are -summarized below. The initial character of each line determines what the -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. +2012\/3\/24 gift + expenses:gifts $10 + assets:cash @ -} module Hledger.Read.JournalReader ( - emptyLine, - journalAddFile, - journalFile, - ledgeraccountname, - ledgerdatetime, - ledgerDefaultYear, - ledgerDirective, - ledgerHistoricalPrice, - reader, - someamount, - tests_Hledger_Read_JournalReader + -- * Reader + reader, + -- * Parsers used elsewhere + emptyLine, + journalFile, + ledgeraccountname, + ledgerdatetime, + ledgerDefaultYear, + ledgerDirective, + ledgerHistoricalPrice, + someamount, + parseJournalWith, + getParentAccount, + -- * Tests + tests_Hledger_Read_JournalReader ) where import Control.Monad @@ -131,9 +48,10 @@ import Safe (headDef) import Test.HUnit import Text.ParserCombinators.Parsec hiding (parse) import Text.Printf +import System.FilePath +import System.Time (getClockTime) import Hledger.Data -import Hledger.Read.Utils import Hledger.Utils import Prelude hiding (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 ? 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 -- 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 +-- 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, -- error-raising "JournalUpdate" (and final "JournalContext") which can be -- applied to an empty journal to get the final result. @@ -164,7 +139,7 @@ journalFile = do journalupdates <- many journalItem eof finalctx <- getState - return $ (juSequence journalupdates, finalctx) + return $ (combineJournalUpdates journalupdates, finalctx) where -- As all journal line types can be distinguished by the first -- character, excepting transactions versus empty (blank or @@ -228,7 +203,7 @@ ledgerInclude = do txt <- readFileOrError outerPos filepath let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" 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 where readFileOrError pos fp = ErrorT $ liftM Right (readFile fp) `catch` diff --git a/hledger-lib/Hledger/Read/TimelogReader.hs b/hledger-lib/Hledger/Read/TimelogReader.hs index 206aaece9..75d872298 100644 --- a/hledger-lib/Hledger/Read/TimelogReader.hs +++ b/hledger-lib/Hledger/Read/TimelogReader.hs @@ -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 +(). Example: + +@ +i 2007\/03\/10 12:26:00 hledger +o 2007\/03\/10 17:26:02 +@ From timeclock.el 2.6: @@ -32,29 +38,26 @@ i, o or O. The meanings of the codes are: 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 ( - reader, - tests_Hledger_Read_TimelogReader + -- * Reader + reader, + -- * Tests + tests_Hledger_Read_TimelogReader ) where import Control.Monad import Control.Monad.Error import Test.HUnit import Text.ParserCombinators.Parsec hiding (parse) +import System.FilePath import Hledger.Data -import Hledger.Read.Utils -import Hledger.Read.JournalReader (ledgerDirective, ledgerHistoricalPrice, - ledgerDefaultYear, emptyLine, ledgerdatetime) +import Hledger.Read.JournalReader ( + ledgerDirective, ledgerHistoricalPrice, ledgerDefaultYear, emptyLine, ledgerdatetime, + parseJournalWith, getParentAccount + ) import Hledger.Utils @@ -66,12 +69,12 @@ format = "timelog" -- | Does the given file path and data provide timeclock.el's timelog format ? 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 -- format, saving the provided file path and the current time, or give an -- error. -parse :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal +parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal parse _ = parseJournalWith timelogFile timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext) diff --git a/hledger-lib/Hledger/Read/Utils.hs b/hledger-lib/Hledger/Read/Utils.hs deleted file mode 100644 index 61741c655..000000000 --- a/hledger-lib/Hledger/Read/Utils.hs +++ /dev/null @@ -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 (/='.') diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 9a1d7ede7..8f2d829a8 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -25,6 +25,7 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c ) where import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded) +import Control.Monad.Error import Data.Char import Data.List import Data.Maybe @@ -32,6 +33,8 @@ import Data.Time.Clock import Data.Time.LocalTime import Data.Tree import Debug.Trace +import System.Directory (getHomeDirectory) +import System.FilePath(takeDirectory,combine) import System.Info (os) import Test.HUnit import Text.ParserCombinators.Parsec @@ -425,3 +428,13 @@ isRight = not . isLeft -- | Apply a function the specified number of times. Possibly uses O(n) stack ? 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) + where + mkAbsolute = combine (takeDirectory (sourceName pos)) + expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory + return $ homedir ++ drop 1 inname + | otherwise = return inname