read system cleanup, require conversion rules from a file to simplify API

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
+     -- 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

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
+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.
 
 -}
 
 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
+-- | 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
                                     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
+-- | 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.
-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
-  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 ()

hledger-lib/Hledger/Read/CsvReader.hs

@@ -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 (
-  CsvRules(..),
+  -- * Reader
-  nullrules,
   reader,
+  -- * Tests
   tests_Hledger_Read_CsvReader
 )
 where
 import Control.Monad
 import Control.Monad.Error
-import Test.HUnit
+-- import Test.HUnit
--- import Text.ParserCombinators.Parsec hiding (parse)
 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
-import System.FilePath (takeBaseName, replaceExtension)
 import System.IO (stderr)
 import System.Locale (defaultTimeLocale)
 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 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 :: 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
             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,
+-- | 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 == "-"
-      -- 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
                   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
+newRulesFileContent :: String
-initialRulesFileContent = let prognameandversion = "hledger" in
+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

hledger-lib/Hledger/Read/JournalReader.hs

@@ -1,119 +1,36 @@
+{-# 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 (
-       emptyLine,
+  -- * Reader
-       journalAddFile,
+  reader,
-       journalFile,
+  -- * Parsers used elsewhere
-       ledgeraccountname,
+  emptyLine,
-       ledgerdatetime,
+  journalFile,
-       ledgerDefaultYear,
+  ledgeraccountname,
-       ledgerDirective,
+  ledgerdatetime,
-       ledgerHistoricalPrice,
+  ledgerDefaultYear,
-       reader,
+  ledgerDirective,
-       someamount,
+  ledgerHistoricalPrice,
-       tests_Hledger_Read_JournalReader
+  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`

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
+(<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:
 
@@ -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,
+  -- * Reader
-       tests_Hledger_Read_TimelogReader
+  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 (
-import Hledger.Read.JournalReader (ledgerDirective, ledgerHistoricalPrice,
+  ledgerDirective, ledgerHistoricalPrice, ledgerDefaultYear, emptyLine, ledgerdatetime,
-                                   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)

hledger-lib/Hledger/Read/Utils.hs

@@ -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 (/='.')

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