hledger-lib 0.10 → 0.11

raw patch · 20 files changed

+1091/−881 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Hledger/Data.hs +3/−9
• Hledger/Data/Account.hs +1/−1
• Hledger/Data/AccountName.hs +6/−2
• Hledger/Data/Amount.hs +6/−4
• Hledger/Data/Commodity.hs +20/−0
• Hledger/Data/Dates.hs +13/−0
• Hledger/Data/IO.hs +0/−84
• Hledger/Data/Journal.hs +25/−20
• Hledger/Data/Ledger.hs +3/−1
• Hledger/Data/Parse.hs +0/−731
• Hledger/Data/Posting.hs +4/−5
• Hledger/Data/TimeLog.hs +3/−3
• Hledger/Data/Transaction.hs +18/−12
• Hledger/Data/Types.hs +1/−1
• Hledger/Data/Utils.hs +14/−2
• Hledger/Read.hs +148/−0
• Hledger/Read/Common.hs +80/−0
• Hledger/Read/Journal.hs +639/−0
• Hledger/Read/Timelog.hs +100/−0
• hledger-lib.cabal +7/−6

@@ -1,8 +1,8 @@ {-|  -The Ledger library allows parsing and querying of ledger files.  It-generally provides a compatible subset of C++ ledger's functionality.-This package re-exports all the Ledger.* modules.+The Hledger.Data library allows parsing and querying of C++ ledger-style+journal files.  It generally provides a compatible subset of C++ ledger's+functionality.  This package re-exports all the Hledger.Data.* modules.  -} @@ -12,10 +12,8 @@                module Hledger.Data.Amount,                module Hledger.Data.Commodity,                module Hledger.Data.Dates,-               module Hledger.Data.IO,                module Hledger.Data.Transaction,                module Hledger.Data.Ledger,-               module Hledger.Data.Parse,                module Hledger.Data.Journal,                module Hledger.Data.Posting,                module Hledger.Data.TimeLog,@@ -29,10 +27,8 @@ import Hledger.Data.Amount import Hledger.Data.Commodity import Hledger.Data.Dates-import Hledger.Data.IO import Hledger.Data.Transaction import Hledger.Data.Ledger-import Hledger.Data.Parse import Hledger.Data.Journal import Hledger.Data.Posting import Hledger.Data.TimeLog@@ -46,10 +42,8 @@      Hledger.Data.Amount.tests_Amount     -- ,Hledger.Data.Commodity.tests_Commodity     ,Hledger.Data.Dates.tests_Dates-    -- ,Hledger.Data.IO.tests_IO     ,Hledger.Data.Transaction.tests_Transaction     -- ,Hledger.Data.Hledger.Data.tests_Hledger.Data-    ,Hledger.Data.Parse.tests_Parse     -- ,Hledger.Data.Journal.tests_Journal     -- ,Hledger.Data.Posting.tests_Posting     ,Hledger.Data.TimeLog.tests_TimeLog

@@ -1,6 +1,6 @@ {-| -A compound data type for efficiency. An 'Account' stores+An 'Account' stores  - an 'AccountName', 

@@ -1,8 +1,9 @@ {-# LANGUAGE NoMonomorphismRestriction#-} {-| -'AccountName's are strings like @assets:cash:petty@.-From a set of these we derive the account hierarchy.+'AccountName's are strings like @assets:cash:petty@, with multiple+components separated by ':'.  From a set of these we derive the account+hierarchy.  -} @@ -30,6 +31,9 @@ accountNameLevel :: AccountName -> Int accountNameLevel "" = 0 accountNameLevel a = length (filter (==acctsepchar) a) + 1++accountNameDrop :: Int -> AccountName -> AccountName+accountNameDrop n = accountNameFromComponents . drop n . accountNameComponents  -- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"] expandAccountNames :: [AccountName] -> [AccountName]

@@ -106,9 +106,10 @@ showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = "" -- can appear in an error message showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) =     case side of-      L -> printf "%s%s%s%s" sym space quantity price-      R -> printf "%s%s%s%s" quantity space sym price-    where +      L -> printf "%s%s%s%s" sym' space quantity price+      R -> printf "%s%s%s%s" quantity space sym' price+    where+      sym' = quoteCommoditySymbolIfNeeded sym       space = if spaced then " " else ""       quantity = showAmount' a       price = case pri of (Just pamt) -> " @ " ++ showMixedAmount pamt@@ -149,7 +150,8 @@ -- | Is this amount "really" zero, regardless of the display precision ? -- Since we are using floating point, for now just test to some high precision. isReallyZeroAmount :: Amount -> Bool-isReallyZeroAmount = null . filter (`elem` "123456789") . printf "%.10f" . quantity+isReallyZeroAmount = null . filter (`elem` "123456789") . printf ("%."++show zeroprecision++"f") . quantity+    where zeroprecision = 8  -- | Access a mixed amount's components. amounts :: MixedAmount -> [Amount]

@@ -10,8 +10,15 @@ where import Hledger.Data.Utils import Hledger.Data.Types+import qualified Data.Map as Map+import Data.Map ((!))  +nonsimplecommoditychars = "0123456789-.@;\n \""++quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" ++ s ++ "\""+                               | otherwise = s+ -- convenient amount and commodity constructors, for tests etc.  unknown = Commodity {symbol="",   side=L,spaced=False,comma=False,precision=0}@@ -37,3 +44,16 @@ conversionRate :: Commodity -> Commodity -> Double conversionRate _ _ = 1 +-- | Convert a list of commodities to a map from commodity symbols to+-- unique, display-preference-canonicalised commodities.+canonicaliseCommodities :: [Commodity] -> Map.Map String Commodity+canonicaliseCommodities cs =+    Map.fromList [(s,firstc{precision=maxp}) | s <- symbols,+                  let cs = commoditymap ! s,+                  let firstc = head cs,+                  let maxp = maximum $ map precision cs+                 ]+  where+    commoditymap = Map.fromList [(s, commoditieswithsymbol s) | s <- symbols]+    commoditieswithsymbol s = filter ((s==) . symbol) cs+    symbols = nub $ map symbol cs

@@ -71,7 +71,20 @@ daysInSpan :: DateSpan -> Maybe Integer daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays d2 d1 daysInSpan _ = Nothing++-- | Does the span include the given date ?+spanContainsDate :: DateSpan -> Day -> Bool+spanContainsDate (DateSpan Nothing Nothing)   _ = True+spanContainsDate (DateSpan Nothing (Just e))  d = d < e+spanContainsDate (DateSpan (Just b) Nothing)  d = d >= b+spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e     +-- | Combine two datespans, filling any unspecified dates in the first+-- with dates from the second.+orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b+    where a = if isJust a1 then a1 else a2+          b = if isJust b1 then b1 else b2+ -- | Parse a period expression to an Interval and overall DateSpan using -- the provided reference date, or raise an error. parsePeriodExpr :: Day -> String -> (Interval, DateSpan)

@@ -1,84 +0,0 @@-{-# LANGUAGE CPP #-}-{-|-Utilities for doing I/O with ledger files.--}--module Hledger.Data.IO-where-import Control.Monad.Error-import Hledger.Data.Parse (parseJournal)-import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..))-import Hledger.Data.Dates (nulldatespan)-import System.Directory (getHomeDirectory)-import System.Environment (getEnv)-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding (readFile)-import System.IO.UTF8-#endif-import System.FilePath ((</>))---ledgerenvvar           = "LEDGER"-timelogenvvar          = "TIMELOG"-ledgerdefaultfilename  = ".ledger"-timelogdefaultfilename = ".timelog"--nullfilterspec = FilterSpec {-     datespan=nulldatespan-    ,cleared=Nothing-    ,real=False-    ,empty=False-    ,costbasis=False-    ,acctpats=[]-    ,descpats=[]-    ,whichdate=ActualDate-    ,depth=Nothing-    }---- | Get the user's default ledger file path.-myLedgerPath :: IO String-myLedgerPath = -    getEnv ledgerenvvar `catch` -               (\_ -> do-                  home <- getHomeDirectory `catch` (\_ -> return "")-                  return $ home </> ledgerdefaultfilename)-  --- | Get the user's default timelog file path.-myTimelogPath :: IO String-myTimelogPath =-    getEnv timelogenvvar `catch`-               (\_ -> do-                  home <- getHomeDirectory-                  return $ home </> timelogdefaultfilename)---- | Read the user's default journal file, or give an error.-myJournal :: IO Journal-myJournal = myLedgerPath >>= readJournal---- | Read the user's default timelog file, or give an error.-myTimelog :: IO Journal-myTimelog = myTimelogPath >>= readJournal---- | Read a journal from this file, or throw an error.-readJournal :: FilePath -> IO Journal-readJournal f = do-  s <- readFile f-  j <- journalFromString s-  return j{filepath=f}---- | Read a Journal from the given string, using the current time as--- reference time, or throw an error.-journalFromString :: String -> IO Journal-journalFromString s = liftM (either error id) $ runErrorT $ parseJournal "(from string)" s---- -- | Expand ~ in a file path (does not handle ~name).--- tildeExpand :: FilePath -> IO FilePath--- tildeExpand ('~':[])     = getHomeDirectory--- tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))--- --handle ~name, requires -fvia-C or ghc 6.8:--- --import System.Posix.User--- -- tildeExpand ('~':xs)     =  do let (user, path) = span (/= '/') xs--- --                                pw <- getUserEntryForName user--- --                                return (homeDirectory pw ++ path)--- tildeExpand xs           =  return xs-

@@ -1,7 +1,8 @@ {-|  A 'Journal' is a set of 'Transaction's and related data, usually parsed-from a hledger/ledger journal file or timelog.+from a hledger/ledger journal file or timelog. This is the primary hledger+data object.  -} @@ -14,7 +15,9 @@ import Hledger.Data.Types import Hledger.Data.AccountName import Hledger.Data.Amount-import Hledger.Data.Transaction (ledgerTransactionWithDate)+import Hledger.Data.Commodity (canonicaliseCommodities)+import Hledger.Data.Dates (nulldatespan)+import Hledger.Data.Transaction (journalTransactionWithDate) import Hledger.Data.Posting import Hledger.Data.TimeLog @@ -42,6 +45,18 @@                       , jtext = ""                       } +nullfilterspec = FilterSpec {+     datespan=nulldatespan+    ,cleared=Nothing+    ,real=False+    ,empty=False+    ,costbasis=False+    ,acctpats=[]+    ,descpats=[]+    ,whichdate=ActualDate+    ,depth=Nothing+    }+ addTransaction :: Transaction -> Journal -> Journal addTransaction t l0 = l0 { jtxns = t : jtxns l0 } @@ -115,20 +130,20 @@     filterJournalTransactionsByDate datespan .     journalSelectingDate whichdate --- | Keep only ledger transactions whose description matches the description patterns.+-- | Keep only transactions whose description matches the description patterns. filterJournalTransactionsByDescription :: [String] -> Journal -> Journal filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts}     where matchdesc = matchpats pats . tdescription --- | Keep only ledger transactions which fall between begin and end dates.+-- | Keep only transactions which fall between begin and end dates. -- We include transactions on the begin date and exclude transactions on the end -- date, like ledger.  An empty date string means no restriction. filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts}     where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end --- | Keep only ledger transactions which have the requested--- cleared/uncleared status, if there is one.+-- | Keep only transactions which have the requested cleared/uncleared+-- status, if there is one. filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal filterJournalTransactionsByClearedStatus Nothing j = j filterJournalTransactionsByClearedStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts}@@ -161,7 +176,7 @@     j{jtxns=(filter (any ((<= d+1) . accountNameLevel . paccount) . tpostings) ts)}  -- | Strip out any postings to accounts deeper than the specified depth--- (and any ledger transactions which have no postings as a result).+-- (and any transactions which have no postings as a result). filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal filterJournalPostingsByDepth Nothing j = j filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} =@@ -194,7 +209,7 @@ journalSelectingDate :: WhichDate -> Journal -> Journal journalSelectingDate ActualDate j = j journalSelectingDate EffectiveDate j =-    j{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns j}+    j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j}  -- | Do post-parse processing on a journal, to make it ready for use. journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> Journal -> Journal@@ -254,17 +269,7 @@  -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. journalCanonicalCommodities :: Journal -> Map.Map String Commodity-journalCanonicalCommodities j =-    Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,-                  let cs = commoditymap ! s,-                  let firstc = head cs,-                  let maxp = maximum $ map precision cs-                 ]-  where-    commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]-    commoditieswithsymbol s = filter ((s==) . symbol) commodities-    commoditysymbols = nub $ map symbol commodities-    commodities = journalAmountAndPriceCommodities j+journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountAndPriceCommodities j  -- | Get all this journal's amounts' commodities, in the order parsed. journalAmountCommodities :: Journal -> [Commodity]@@ -292,7 +297,7 @@     where       ts = sortBy (comparing tdate) $ jtxns j --- | Check if a set of ledger account/description patterns matches the+-- | Check if a set of hledger account/description filter patterns matches the -- given account name or entry description.  Patterns are case-insensitive -- regular expressions. Prefixed with not:, they become anti-patterns. matchpats :: [String] -> String -> Bool

@@ -33,7 +33,9 @@       accountmap = fromList []     } --- | Filter a ledger's transactions as specified and generate derived data.+-- | Filter a journal's transactions as specified, and then process them+-- to derive a ledger containing all balances, the chart of accounts,+-- canonicalised commodities etc. journalToLedger :: FilterSpec -> Journal -> Ledger journalToLedger fs j = nullledger{journal=j',accountnametree=t,accountmap=m}     where j' = filterJournalPostings fs{depth=Nothing} j

@@ -1,731 +0,0 @@-{-# LANGUAGE CPP #-}-{-|--Parsers for standard ledger and timelog files.--Here is the ledger grammar from the ledger 2.5 manual:--@-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.-@--Here is the timelog grammar from timeclock.el 2.6:--@-A timelog contains data in the form of a single entry per line.-Each entry has the form:--  CODE YYYY/MM/DD HH:MM:SS [COMMENT]--CODE is one of: b, h, i, o or O.  COMMENT is optional when the code is-i, o or O.  The meanings of the codes are:--  b  Set the current time balance, or \"time debt\".  Useful when-     archiving old log data, when a debt must be carried forward.-     The COMMENT here is the number of seconds of debt.--  h  Set the required working time for the given day.  This must-     be the first entry for that day.  The COMMENT in this case is-     the number of hours in this workday.  Floating point amounts-     are allowed.--  i  Clock in.  The COMMENT in this case should be the name of the-     project worked on.--  o  Clock out.  COMMENT is unnecessary, but can be used to provide-     a description of how the period went, for example.--  O  Final clock out.  Whatever project was being worked on, it is-     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.Data.Parse-where-import Control.Monad.Error (ErrorT(..), MonadIO, liftIO, throwError, catchError)-import Text.ParserCombinators.Parsec-import System.Directory-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding (readFile, putStr, putStrLn, print, getContents)-import System.IO.UTF8-#endif-import Hledger.Data.Utils-import Hledger.Data.Types-import Hledger.Data.Dates-import Hledger.Data.AccountName (accountNameFromComponents,accountNameComponents)-import Hledger.Data.Amount-import Hledger.Data.Transaction-import Hledger.Data.Posting-import Hledger.Data.Journal-import Hledger.Data.Commodity (dollars,dollar,unknown)-import System.FilePath(takeDirectory,combine)-import System.Time (getClockTime)----- | A JournalUpdate is some transformation of a "Journal". It can do I/O--- or raise an error.-type JournalUpdate = ErrorT String IO (Journal -> Journal)---- | Some context kept during parsing.-data LedgerFileCtx = Ctx {-      ctxYear     :: !(Maybe Integer)  -- ^ the default year most recently specified with Y-    , ctxCommod   :: !(Maybe String)   -- ^ I don't know-    , ctxAccount  :: ![String]         -- ^ the current stack of parent accounts specified by !account-    } deriving (Read, Show)--emptyCtx :: LedgerFileCtx-emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }--setYear :: Integer -> GenParser tok LedgerFileCtx ()-setYear y = updateState (\ctx -> ctx{ctxYear=Just y})--getYear :: GenParser tok LedgerFileCtx (Maybe Integer)-getYear = liftM ctxYear getState--pushParentAccount :: String -> GenParser tok LedgerFileCtx ()-pushParentAccount parent = updateState addParentAccount-    where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }-          normalize = (++ ":") --popParentAccount :: GenParser tok LedgerFileCtx ()-popParentAccount = do ctx0 <- getState-                      case ctxAccount ctx0 of-                        [] -> unexpected "End of account block with no beginning"-                        (_:rest) -> setState $ ctx0 { ctxAccount = rest }--getParentAccount :: GenParser tok LedgerFileCtx String-getParentAccount = liftM (concat . reverse . ctxAccount) getState--expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath-expandPath pos fp = liftM mkRelative (expandHome fp)-  where-    mkRelative = combine (takeDirectory (sourceName pos))-    expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory-                                                      return $ homedir ++ drop 1 inname-                      | otherwise                = return inname---- let's get to it---- | Parse and post-process a journal file or timelog file to a "Journal",--- or give an error.-parseJournalFile :: FilePath -> ErrorT String IO Journal-parseJournalFile "-" = liftIO getContents >>= parseJournal "-"-parseJournalFile f   = liftIO (readFile f) >>= parseJournal f---- | Parse and post-process a "Journal" from a string, saving the provided--- file path and the current time, or give an error.-parseJournal :: FilePath -> String -> ErrorT String IO Journal-parseJournal f s = do-  tc <- liftIO getClockTime-  tl <- liftIO getCurrentLocalTime-  case runParser ledgerFile emptyCtx f s of-    Right m  -> liftM (journalFinalise tc tl f s) $ m `ap` return nulljournal-    Left err -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ?---- | Top-level journal parser. Returns a single composite, I/O performing,--- error-raising "JournalUpdate" which can be applied to an empty journal--- to get the final result.-ledgerFile :: GenParser Char LedgerFileCtx JournalUpdate-ledgerFile = do items <- many ledgerItem-                eof-                return $ liftM (foldr (.) id) $ sequence items-    where -      -- As all ledger line types can be distinguished by the first-      -- character, excepting transactions versus empty (blank or-      -- comment-only) lines, can use choice w/o try-      ledgerItem = choice [ ledgerExclamationDirective-                          , liftM (return . addTransaction) ledgerTransaction-                          , liftM (return . addModifierTransaction) ledgerModifierTransaction-                          , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction-                          , liftM (return . addHistoricalPrice) ledgerHistoricalPrice-                          , ledgerDefaultYear-                          , ledgerIgnoredPriceCommodity-                          , ledgerTagDirective-                          , ledgerEndTagDirective-                          , emptyLine >> return (return id)-                          , liftM (return . addTimeLogEntry)  timelogentry-                          ] <?> "ledger transaction, timelog entry, or directive"--emptyLine :: GenParser Char st ()-emptyLine = do many spacenonewline-               optional $ (char ';' <?> "comment") >> many (noneOf "\n")-               newline-               return ()--ledgercomment :: GenParser Char st String-ledgercomment = do-  many1 $ char ';'-  many spacenonewline-  many (noneOf "\n")-  <?> "comment"--ledgercommentline :: GenParser Char st String-ledgercommentline = do-  many spacenonewline-  s <- ledgercomment-  optional newline-  eof-  return s-  <?> "comment"--ledgerExclamationDirective :: GenParser Char LedgerFileCtx JournalUpdate-ledgerExclamationDirective = do-  char '!' <?> "directive"-  directive <- many nonspace-  case directive of-    "include" -> ledgerInclude-    "account" -> ledgerAccountBegin-    "end"     -> ledgerAccountEnd-    _         -> mzero--ledgerInclude :: GenParser Char LedgerFileCtx JournalUpdate-ledgerInclude = do many1 spacenonewline-                   filename <- restofline-                   outerState <- getState-                   outerPos <- getPosition-                   let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"-                   return $ do contents <- expandPath outerPos filename >>= readFileE outerPos-                               case runParser ledgerFile outerState filename contents of-                                 Right l   -> l `catchError` (throwError . (inIncluded ++))-                                 Left perr -> throwError $ inIncluded ++ show perr-    where readFileE outerPos filename = ErrorT $ liftM Right (readFile filename) `catch` leftError-              where leftError err = return $ Left $ currentPos ++ whileReading ++ show err-                    currentPos = show outerPos-                    whileReading = " reading " ++ show filename ++ ":\n"--ledgerAccountBegin :: GenParser Char LedgerFileCtx JournalUpdate-ledgerAccountBegin = do many1 spacenonewline-                        parent <- ledgeraccountname-                        newline-                        pushParentAccount parent-                        return $ return id--ledgerAccountEnd :: GenParser Char LedgerFileCtx JournalUpdate-ledgerAccountEnd = popParentAccount >> return (return id)--ledgerModifierTransaction :: GenParser Char LedgerFileCtx ModifierTransaction-ledgerModifierTransaction = do-  char '=' <?> "modifier transaction"-  many spacenonewline-  valueexpr <- restofline-  postings <- ledgerpostings-  return $ ModifierTransaction valueexpr postings--ledgerPeriodicTransaction :: GenParser Char LedgerFileCtx PeriodicTransaction-ledgerPeriodicTransaction = do-  char '~' <?> "periodic transaction"-  many spacenonewline-  periodexpr <- restofline-  postings <- ledgerpostings-  return $ PeriodicTransaction periodexpr postings--ledgerHistoricalPrice :: GenParser Char LedgerFileCtx HistoricalPrice-ledgerHistoricalPrice = do-  char 'P' <?> "historical price"-  many spacenonewline-  date <- try (do {LocalTime d _ <- ledgerdatetime; return d}) <|> ledgerdate -- a time is ignored-  many1 spacenonewline-  symbol <- commoditysymbol-  many spacenonewline-  price <- someamount-  restofline-  return $ HistoricalPrice date symbol price--ledgerIgnoredPriceCommodity :: GenParser Char LedgerFileCtx JournalUpdate-ledgerIgnoredPriceCommodity = do-  char 'N' <?> "ignored-price commodity"-  many1 spacenonewline-  commoditysymbol-  restofline-  return $ return id--ledgerDefaultCommodity :: GenParser Char LedgerFileCtx JournalUpdate-ledgerDefaultCommodity = do-  char 'D' <?> "default commodity"-  many1 spacenonewline-  someamount-  restofline-  return $ return id--ledgerCommodityConversion :: GenParser Char LedgerFileCtx JournalUpdate-ledgerCommodityConversion = do-  char 'C' <?> "commodity conversion"-  many1 spacenonewline-  someamount-  many spacenonewline-  char '='-  many spacenonewline-  someamount-  restofline-  return $ return id--ledgerTagDirective :: GenParser Char LedgerFileCtx JournalUpdate-ledgerTagDirective = do-  string "tag" <?> "tag directive"-  many1 spacenonewline-  _ <- many1 nonspace-  restofline-  return $ return id--ledgerEndTagDirective :: GenParser Char LedgerFileCtx JournalUpdate-ledgerEndTagDirective = do-  string "end tag" <?> "end tag directive"-  restofline-  return $ return id---- like ledgerAccountBegin, updates the LedgerFileCtx-ledgerDefaultYear :: GenParser Char LedgerFileCtx JournalUpdate-ledgerDefaultYear = do-  char 'Y' <?> "default year"-  many spacenonewline-  y <- many1 digit-  let y' = read y-  failIfInvalidYear y-  setYear y'-  return $ return id---- | Try to parse a ledger entry. If we successfully parse an entry,--- check it can be balanced, and fail if not.-ledgerTransaction :: GenParser Char LedgerFileCtx Transaction-ledgerTransaction = do-  date <- ledgerdate <?> "transaction"-  edate <- optionMaybe (ledgereffectivedate date) <?> "effective date"-  status <- ledgerstatus <?> "cleared flag"-  code <- ledgercode <?> "transaction code"-  (description, comment) <--      (do {many1 spacenonewline; d <- liftM rstrip (many (noneOf ";\n")); c <- ledgercomment <|> return ""; newline; return (d, c)} <|>-       do {many spacenonewline; c <- ledgercomment <|> return ""; newline; return ("", c)}-      ) <?> "description and/or comment"-  postings <- ledgerpostings-  let t = txnTieKnot $ Transaction date edate status code description comment postings ""-  case balanceTransaction t of-    Right t' -> return t'-    Left err -> fail err--ledgerdate :: GenParser Char LedgerFileCtx Day-ledgerdate = choice' [ledgerfulldate, ledgerpartialdate] <?> "full or partial date"--ledgerfulldate :: GenParser Char LedgerFileCtx Day-ledgerfulldate = do-  (y,m,d) <- ymd-  return $ fromGregorian (read y) (read m) (read d)---- | Match a partial M/D date in a ledger, and also require that a default--- year directive was previously encountered.-ledgerpartialdate :: GenParser Char LedgerFileCtx Day-ledgerpartialdate = do-  (_,m,d) <- md-  y <- getYear-  when (isNothing y) $ fail "partial date found, but no default year specified"-  return $ fromGregorian (fromJust y) (read m) (read d)--ledgerdatetime :: GenParser Char LedgerFileCtx LocalTime-ledgerdatetime = do -  day <- ledgerdate-  many1 spacenonewline-  h <- many1 digit-  char ':'-  m <- many1 digit-  s <- optionMaybe $ do-      char ':'-      many1 digit-  let tod = TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)-  return $ LocalTime day tod--ledgereffectivedate :: Day -> GenParser Char LedgerFileCtx Day-ledgereffectivedate actualdate = do-  char '='-  -- kludgy way to use actual date for default year-  let withDefaultYear d p = do-        y <- getYear-        let (y',_,_) = toGregorian d in setYear y'-        r <- p-        when (isJust y) $ setYear $ fromJust y-        return r-  edate <- withDefaultYear actualdate ledgerdate-  return edate--ledgerstatus :: GenParser Char st Bool-ledgerstatus = try (do { many1 spacenonewline; char '*' <?> "status"; return True } ) <|> return False--ledgercode :: GenParser Char st String-ledgercode = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""--ledgerpostings :: GenParser Char LedgerFileCtx [Posting]-ledgerpostings = do-  -- complicated to handle intermixed comment lines.. please make me better.-  ctx <- getState-  let parses p = isRight . parseWithCtx ctx p-  ls <- many1 $ try linebeginningwithspaces-  let ls' = filter (not . (ledgercommentline `parses`)) ls-  when (null ls') $ fail "no postings"-  return $ map (fromparse . parseWithCtx ctx ledgerposting) ls'-  <?> "postings"--linebeginningwithspaces :: GenParser Char st String-linebeginningwithspaces = do-  sp <- many1 spacenonewline-  c <- nonspace-  cs <- restofline-  return $ sp ++ (c:cs) ++ "\n"--ledgerposting :: GenParser Char LedgerFileCtx Posting-ledgerposting = do-  many1 spacenonewline-  status <- ledgerstatus-  account <- transactionaccountname-  let (ptype, account') = (postingTypeFromAccountName account, unbracket account)-  amount <- postingamount-  many spacenonewline-  comment <- ledgercomment <|> return ""-  newline-  return (Posting status account' amount comment ptype Nothing)---- qualify with the parent account from parsing context-transactionaccountname :: GenParser Char LedgerFileCtx AccountName-transactionaccountname = liftM2 (++) getParentAccount ledgeraccountname---- | Parse an account name. Account names may have single spaces inside--- them, and are terminated by two or more spaces. They should have one or--- more components of at least one character, separated by the account--- separator char.-ledgeraccountname :: GenParser Char st AccountName-ledgeraccountname = do-    a <- many1 (nonspace <|> singlespace)-    let a' = striptrailingspace a-    when (accountNameFromComponents (accountNameComponents a') /= a')-         (fail $ "accountname seems ill-formed: "++a')-    return a'-    where -      singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})-      -- couldn't avoid consuming a final space sometimes, harmless-      striptrailingspace s = if last s == ' ' then init s else s---- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace---     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"---- | Parse an amount, with an optional left or right currency symbol and--- optional price.-postingamount :: GenParser Char st MixedAmount-postingamount =-  try (do-        many1 spacenonewline-        someamount <|> return missingamt-      ) <|> return missingamt--someamount :: GenParser Char st MixedAmount-someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount --leftsymbolamount :: GenParser Char st MixedAmount-leftsymbolamount = do-  sym <- commoditysymbol -  sp <- many spacenonewline-  (q,p,comma) <- amountquantity-  pri <- priceamount-  let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p}-  return $ Mixed [Amount c q pri]-  <?> "left-symbol amount"--rightsymbolamount :: GenParser Char st MixedAmount-rightsymbolamount = do-  (q,p,comma) <- amountquantity-  sp <- many spacenonewline-  sym <- commoditysymbol-  pri <- priceamount-  let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p}-  return $ Mixed [Amount c q pri]-  <?> "right-symbol amount"--nosymbolamount :: GenParser Char st MixedAmount-nosymbolamount = do-  (q,p,comma) <- amountquantity-  pri <- priceamount-  let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p}-  return $ Mixed [Amount c q pri]-  <?> "no-symbol amount"--commoditysymbol :: GenParser Char st String-commoditysymbol = (quotedcommoditysymbol <|>-                   many1 (noneOf "0123456789-.@;\n \"")-                  ) <?> "commodity symbol"--quotedcommoditysymbol :: GenParser Char st String-quotedcommoditysymbol = do-  char '"'-  s <- many1 $ noneOf "-.@;\n \""-  char '"'-  return s--priceamount :: GenParser Char st (Maybe MixedAmount)-priceamount =-    try (do-          many spacenonewline-          char '@'-          many spacenonewline-          a <- someamount -- XXX could parse more prices ad infinitum, shouldn't-          return $ Just a-          ) <|> return Nothing---- gawd.. trying to parse a ledger number without error:---- | Parse a ledger-style numeric quantity and also return the number of--- digits to the right of the decimal point and whether thousands are--- separated by comma.-amountquantity :: GenParser Char st (Double, Int, Bool)-amountquantity = do-  sign <- optionMaybe $ string "-"-  (intwithcommas,frac) <- numberparts-  let comma = ',' `elem` intwithcommas-  let precision = length frac-  -- read the actual value. We expect this read to never fail.-  let int = filter (/= ',') intwithcommas-  let int' = if null int then "0" else int-  let frac' = if null frac then "0" else frac-  let sign' = fromMaybe "" sign-  let quantity = read $ sign'++int'++"."++frac'-  return (quantity, precision, comma)-  <?> "commodity quantity"---- | parse the two strings of digits before and after a possible decimal--- point.  The integer part may contain commas, or either part may be--- empty, or there may be no point.-numberparts :: GenParser Char st (String,String)-numberparts = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint--numberpartsstartingwithdigit :: GenParser Char st (String,String)-numberpartsstartingwithdigit = do-  let digitorcomma = digit <|> char ','-  first <- digit-  rest <- many digitorcomma-  frac <- try (do {char '.'; many digit}) <|> return ""-  return (first:rest,frac)-                     -numberpartsstartingwithpoint :: GenParser Char st (String,String)-numberpartsstartingwithpoint = do-  char '.'-  frac <- many1 digit-  return ("",frac)-                     ---- | Parse a timelog entry.-timelogentry :: GenParser Char LedgerFileCtx TimeLogEntry-timelogentry = do-  code <- oneOf "bhioO"-  many1 spacenonewline-  datetime <- ledgerdatetime-  comment <- optionMaybe (many1 spacenonewline >> liftM2 (++) getParentAccount restofline)-  return $ TimeLogEntry (read [code]) datetime (fromMaybe "" comment)----- | Parse a hledger display expression, which is a simple date test like--- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.-datedisplayexpr :: GenParser Char st (Posting -> Bool)-datedisplayexpr = do-  char 'd'-  op <- compareop-  char '['-  (y,m,d) <- smartdate-  char ']'-  let date    = parsedate $ printf "%04s/%02s/%02s" y m d-      test op = return $ (`op` date) . postingDate-  case op of-    "<"  -> test (<)-    "<=" -> test (<=)-    "="  -> test (==)-    "==" -> test (==)-    ">=" -> test (>=)-    ">"  -> test (>)-    _    -> mzero--compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]---tests_Parse = TestList [--   "ledgerTransaction" ~: do-    assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1-    assertBool "ledgerTransaction should not parse just a date"-                   $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n"-    assertBool "ledgerTransaction should require some postings"-                   $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n"-    let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"-    assertBool "ledgerTransaction should not include a comment in the description"-                   $ either (const False) ((== "a") . tdescription) t--  ,"ledgerModifierTransaction" ~: do-     assertParse (parseWithCtx emptyCtx ledgerModifierTransaction "= (some value expr)\n some:postings  1\n")--  ,"ledgerPeriodicTransaction" ~: do-     assertParse (parseWithCtx emptyCtx ledgerPeriodicTransaction "~ (some period expr)\n some:postings  1\n")--  ,"ledgerExclamationDirective" ~: do-     assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!include /some/file.x\n")-     assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!account some:account\n")-     assertParse (parseWithCtx emptyCtx (ledgerExclamationDirective >> ledgerExclamationDirective) "!account a\n!end\n")--  ,"ledgercommentline" ~: do-     assertParse (parseWithCtx emptyCtx ledgercommentline "; some comment \n")-     assertParse (parseWithCtx emptyCtx ledgercommentline " \t; x\n")-     assertParse (parseWithCtx emptyCtx ledgercommentline ";x")--  ,"ledgerDefaultYear" ~: do-     assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 2010\n")-     assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 10001\n")--  ,"ledgerHistoricalPrice" ~:-    assertParseEqual (parseWithCtx emptyCtx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55])--  ,"ledgerIgnoredPriceCommodity" ~: do-     assertParse (parseWithCtx emptyCtx ledgerIgnoredPriceCommodity "N $\n")--  ,"ledgerDefaultCommodity" ~: do-     assertParse (parseWithCtx emptyCtx ledgerDefaultCommodity "D $1,000.0\n")--  ,"ledgerCommodityConversion" ~: do-     assertParse (parseWithCtx emptyCtx ledgerCommodityConversion "C 1h = $50.00\n")--  ,"ledgerTagDirective" ~: do-     assertParse (parseWithCtx emptyCtx ledgerTagDirective "tag foo \n")--  ,"ledgerEndTagDirective" ~: do-     assertParse (parseWithCtx emptyCtx ledgerEndTagDirective "end tag \n")--  ,"ledgeraccountname" ~: do-    assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c")-    assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c")-    assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c")-    assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")-- ,"ledgerposting" ~: do-    assertParseEqual (parseWithCtx emptyCtx ledgerposting "  expenses:food:dining  $10.00\n") -                     (Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing)-    assertBool "ledgerposting parses a quoted commodity with numbers"-                   (isRight $ parseWithCtx emptyCtx ledgerposting "  a  1 \"DE123\"\n")--  ,"someamount" ~: do-     let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity-         assertMixedAmountParse parseresult mixedamount =-             (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)-     assertMixedAmountParse (parsewith someamount "1 @ $2")-                            (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])])--  ,"postingamount" ~: do-    assertParseEqual (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18])-    assertParseEqual (parseWithCtx emptyCtx postingamount " $1.")-                (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])-- ]--entry1_str = unlines- ["2007/01/28 coopportunity"- ,"    expenses:food:groceries                   $47.18"- ,"    assets:checking                          $-47.18"- ,""- ]--entry1 =-    txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""-     [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing, -      Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting Nothing] ""--

@@ -4,6 +4,7 @@ single 'Account'.  Each 'Transaction' contains two or more postings which should add up to 0. Postings also reference their parent transaction, so we can get a date or description for a posting (from the transaction).+Strictly speaking, \"entry\" is probably a better name for these.  -} @@ -13,7 +14,7 @@ import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.AccountName-import Hledger.Data.Dates (nulldate)+import Hledger.Data.Dates (nulldate, spanContainsDate)   instance Show Posting where show = showPosting@@ -34,6 +35,7 @@       showamount = padleft 12 . showMixedAmountOrZero       comment = if null com then "" else "  ; " ++ com -- XXX refactor+showPostingForRegister :: Posting -> String showPostingForRegister (Posting{paccount=a,pamount=amt,ptype=t}) =     concatTopPadded [showaccountname a ++ " ", showamount amt]     where@@ -77,10 +79,7 @@  -- | Does this posting fall within the given date span ? isPostingInDateSpan :: DateSpan -> Posting -> Bool-isPostingInDateSpan (DateSpan Nothing Nothing)   _ = True-isPostingInDateSpan (DateSpan Nothing (Just e))  p = postingDate p < e-isPostingInDateSpan (DateSpan (Just b) Nothing)  p = postingDate p >= b-isPostingInDateSpan (DateSpan (Just b) (Just e)) p = d >= b && d < e where d = postingDate p+isPostingInDateSpan s = spanContainsDate s . postingDate  isEmptyPosting :: Posting -> Bool isEmptyPosting = isZeroMixedAmount . pamount

@@ -34,7 +34,7 @@     readsPrec _ ('O' : xs) = [(FinalOut, xs)]     readsPrec _ _ = [] --- | Convert time log entries to ledger transactions. When there is no+-- | Convert time log entries to journal transactions. When there is no -- clockout, add one with the provided current time. Sessions crossing -- midnight are split into days to give accurate per-day totals. timeLogEntriesToTransactions :: LocalTime -> [TimeLogEntry] -> [Transaction]@@ -58,8 +58,8 @@       o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}       i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} --- | Convert a timelog clockin and clockout entry to an equivalent ledger--- entry, representing the time expenditure. Note this entry is  not balanced,+-- | Convert a timelog clockin and clockout entry to an equivalent journal+-- transaction, representing the time expenditure. Note this entry is  not balanced, -- since we omit the \"assets:time\" transaction for simpler output. entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Transaction entryFromTimeLogInOut i o

@@ -1,7 +1,8 @@ {-| -A 'Transaction' represents a single balanced entry in the ledger file. It-normally contains two or more balanced 'Posting's.+A 'Transaction' consists of two or more related 'Posting's which balance+to zero, representing a movement of some commodity(ies) between accounts,+plus a date and optional metadata like description and cleared status.  -} @@ -35,7 +36,7 @@                   }  {-|-Show a ledger entry, formatted for the print command. ledger 2.x's+Show a journal transaction, formatted for the print command. ledger 2.x's standard format looks like this:  @@@ -77,13 +78,18 @@               = map showposting (init ps) ++ [showpostingnoamt (last ps)]           | otherwise = map showposting ps           where-            showposting p = showacct p ++ "  " ++ showamount (pamount p) ++ showcomment (pcomment p)             showpostingnoamt p = rstrip $ showacct p ++ "              " ++ showcomment (pcomment p)+            showposting p = concatTopPadded [showacct p+                                            ,"  "+                                            ,showamt (pamount p)+                                            ,showcomment (pcomment p)+                                            ]             showacct p = "    " ++ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p))-            w = maximum $ map (length . paccount) ps-            showamount = printf "%12s" . showMixedAmountOrZero+                where w = maximum $ map (length . paccount) ps+                      showstatus p = if pstatus p then "* " else ""+            showamt =+                padleft 12 . showMixedAmountOrZero             showcomment s = if null s then "" else "  ; "++s-            showstatus p = if pstatus p then "* " else ""  -- | Show an account name, clipped to the given width if any, and -- appropriately bracketed/parenthesised for the given posting type.@@ -149,15 +155,15 @@     where       (rsum, _, bvsum) = transactionPostingBalances t       rmsg | isReallyZeroMixedAmountCost rsum = ""-           | otherwise = "real postings are off by " ++ show rsum+           | otherwise = "real postings are off by " ++ show (costOfMixedAmount rsum)       bvmsg | isReallyZeroMixedAmountCost bvsum = ""-            | otherwise = "balanced virtual postings are off by " ++ show bvsum+            | otherwise = "balanced virtual postings are off by " ++ show (costOfMixedAmount bvsum)       sep = if not (null rmsg) && not (null bvmsg) then "; " else ""  -- | Convert the primary date to either the actual or effective date.-ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction-ledgerTransactionWithDate ActualDate t = t-ledgerTransactionWithDate EffectiveDate t = txnTieKnot t{tdate=fromMaybe (tdate t) (teffectivedate t)}+journalTransactionWithDate :: WhichDate -> Transaction -> Transaction+journalTransactionWithDate ActualDate t = t+journalTransactionWithDate EffectiveDate t = txnTieKnot t{tdate=fromMaybe (tdate t) (teffectivedate t)}       -- | Ensure a transaction's postings refer back to it.

@@ -16,7 +16,7 @@  For more detailed documentation on each type, see the corresponding modules. -Evolution of transaction/entry/posting terminology:+Evolution of transaction\/entry\/posting terminology:    - ledger 2:    entries contain transactions 

@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} {-| -Provide standard imports and utilities which are useful everywhere, or-needed low in the module hierarchy. This is the bottom of the dependency graph.+Standard imports and utilities which are useful everywhere, or needed low+in the module hierarchy. This is the bottom of hledger's module graph.  -} @@ -321,3 +321,15 @@  strictReadFile :: FilePath -> IO String strictReadFile f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s++-- -- | Expand ~ in a file path (does not handle ~name).+-- tildeExpand :: FilePath -> IO FilePath+-- tildeExpand ('~':[])     = getHomeDirectory+-- tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))+-- --handle ~name, requires -fvia-C or ghc 6.8:+-- --import System.Posix.User+-- -- tildeExpand ('~':xs)     =  do let (user, path) = span (/= '/') xs+-- --                                pw <- getUserEntryForName user+-- --                                return (homeDirectory pw ++ path)+-- tildeExpand xs           =  return xs+

@@ -0,0 +1,148 @@+{-# LANGUAGE CPP #-}+{-| ++Read hledger data from various data formats, and related utilities.++-}++module Hledger.Read (+       tests_Hledger_Read,+       readJournalFile,+       readJournal,+       journalFromPathAndString,+       myJournalPath,+       myTimelogPath,+       myJournal,+       myTimelog,+)+where+import Hledger.Data.Dates (getCurrentDay)+import Hledger.Data.Types (Journal(..))+import Hledger.Data.Utils+import Hledger.Read.Common+import Hledger.Read.Journal as Journal+import Hledger.Read.Timelog as Timelog++import Control.Monad.Error+import Data.Either (partitionEithers)+import Safe (headDef)+import System.Directory (doesFileExist, getHomeDirectory)+import System.Environment (getEnv)+import System.FilePath ((</>))+import System.IO (IOMode(..), withFile, hGetContents, stderr)+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding (readFile, putStr, putStrLn, print, getContents)+import System.IO.UTF8+#else+import System.IO (hPutStrLn)+#endif+++journalenvvar           = "LEDGER"+timelogenvvar          = "TIMELOG"+journaldefaultfilename  = ".journal"+timelogdefaultfilename = ".timelog"++-- Here are the available readers. The first is the default, used for unknown data formats.+readers :: [Reader]+readers = [+  Journal.reader+ ,Timelog.reader+ ]++formats   = map rFormat readers++readerForFormat :: String -> Maybe Reader+readerForFormat s | null rs = Nothing+                  | otherwise = Just $ head rs+    where +      rs = filter ((s==).rFormat) readers :: [Reader]++-- | Read a Journal from this string (and file path), auto-detecting the+-- data format, or give a useful error string. Tries to parse each known+-- data format in turn. If none succeed, gives the error message specific+-- to the intended data format, which if not specified is guessed from the+-- file suffix and possibly the data.+journalFromPathAndString :: Maybe String -> FilePath -> String -> IO (Either String Journal)+journalFromPathAndString format fp s = do+  let readers' = case format of Just f -> case readerForFormat f of Just r -> [r]+                                                                    Nothing -> []+                                Nothing -> readers+  (errors, journals) <- partitionEithers `fmap` mapM tryReader readers'+  case journals of j:_ -> return $ Right j+                   _   -> let s = errMsg errors in hPutStrLn stderr s >> return (Left s)+    where+      tryReader r = (runErrorT . (rParser r) fp) s+      errMsg [] = unknownFormatMsg+      errMsg es = printf "could not parse %s data in %s\n%s" (rFormat r) fp e+          where (r,e) = headDef (head readers, head es) $ filter detects $ zip readers es+                detects (r,_) = (rDetector r) fp s+      unknownFormatMsg = printf "could not parse %sdata in %s" (fmt formats) fp+          where fmt [] = ""+                fmt [f] = f ++ " "+                fmt fs = intercalate ", " (init fs) ++ " or " ++ last fs ++ " "++-- | Read a journal from this file, using the specified data format or+-- trying all known formats, or give an error string; also create the file+-- if it doesn't exist.+readJournalFile :: Maybe String -> FilePath -> IO (Either String Journal)+readJournalFile format "-" = getContents >>= journalFromPathAndString format "(stdin)"+readJournalFile format f = do+  ensureJournalFile f+  withFile f ReadMode $ \h -> hGetContents h >>= journalFromPathAndString format f++-- | Ensure there is a journal at the given file path, creating an empty one if needed.+ensureJournalFile :: FilePath -> IO ()+ensureJournalFile f = do+  exists <- doesFileExist f+  when (not exists) $ do+    hPrintf stderr "No journal file \"%s\", creating it.\n" f+    hPrintf stderr "Edit this file or use \"hledger add\" or \"hledger web\" to add transactions.\n"+    emptyJournal >>= writeFile f++-- | Give the content for a new auto-created journal file.+emptyJournal :: IO String+emptyJournal = do+  d <- getCurrentDay+  return $ printf "; journal created %s; see http://hledger.org/MANUAL.html#journal-file\n\n" (show d)++-- | Read a Journal from this string, using the specified data format or+-- trying all known formats, or give an error string.+readJournal :: Maybe String -> String -> IO (Either String Journal)+readJournal format s = journalFromPathAndString format "(string)" s++-- | Get the user's default journal file path.+myJournalPath :: IO String+myJournalPath =+    getEnv journalenvvar `catch`+               (\_ -> do+                  home <- getHomeDirectory `catch` (\_ -> return "")+                  return $ home </> journaldefaultfilename)+  +-- | Get the user's default timelog file path.+myTimelogPath :: IO String+myTimelogPath =+    getEnv timelogenvvar `catch`+               (\_ -> do+                  home <- getHomeDirectory+                  return $ home </> timelogdefaultfilename)++-- | Read the user's default journal file, or give an error.+myJournal :: IO Journal+myJournal = myJournalPath >>= readJournalFile Nothing >>= either error return++-- | Read the user's default timelog file, or give an error.+myTimelog :: IO Journal+myTimelog = myTimelogPath >>= readJournalFile Nothing >>= either error return++tests_Hledger_Read = TestList+  [++   "journalFile" ~: do+    assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx emptyCtx Journal.journalFile "")+    jE <- readJournal Nothing "" -- don't know how to get it from journalFile+    either error (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE++  ,Journal.tests_Journal+  ,Timelog.tests_Timelog+  ]

@@ -0,0 +1,80 @@+{-|++Common utilities for hledger data readers, such as the context (state)+that is kept while parsing a journal.++-}++module Hledger.Read.Common+where++import Control.Monad.Error+import Hledger.Data.Utils+import Hledger.Data.Types (Journal)+import Hledger.Data.Journal+import System.Directory (getHomeDirectory)+import System.FilePath(takeDirectory,combine)+import System.Time (getClockTime)+import Text.ParserCombinators.Parsec+++-- | A hledger data reader is a triple of format name, format-detecting predicate, and a parser to Journal.+data Reader = Reader {rFormat   :: String+                     ,rDetector :: FilePath -> String -> Bool+                     ,rParser   :: FilePath -> String -> ErrorT String IO Journal+                     }++-- | A JournalUpdate is some transformation of a "Journal". It can do I/O+-- or raise an error.+type JournalUpdate = ErrorT String IO (Journal -> Journal)++-- | 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) -> FilePath -> String -> ErrorT String IO Journal+parseJournalWith p f s = do+  tc <- liftIO getClockTime+  tl <- liftIO getCurrentLocalTime+  case runParser p emptyCtx f s of+    Right updates -> liftM (journalFinalise tc tl f s) $ updates `ap` return nulljournal+    Left err      -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ?++-- | Some state kept while parsing a journal file.+data JournalContext = Ctx {+      ctxYear     :: !(Maybe Integer)  -- ^ the default year most recently specified with Y+    , ctxCommod   :: !(Maybe String)   -- ^ I don't know+    , ctxAccount  :: ![String]         -- ^ the current stack of parent accounts specified by !account+    } deriving (Read, Show)++emptyCtx :: JournalContext+emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }++setYear :: Integer -> GenParser tok JournalContext ()+setYear y = updateState (\ctx -> ctx{ctxYear=Just y})++getYear :: GenParser tok JournalContext (Maybe Integer)+getYear = liftM ctxYear getState++pushParentAccount :: String -> GenParser tok JournalContext ()+pushParentAccount parent = updateState addParentAccount+    where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }+          normalize = (++ ":") ++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 (concat . reverse . ctxAccount) getState++expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath+expandPath pos fp = liftM mkRelative (expandHome fp)+  where+    mkRelative = combine (takeDirectory (sourceName pos))+    expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory+                                                      return $ homedir ++ drop 1 inname+                      | otherwise                = return inname++fileSuffix :: FilePath -> String+fileSuffix = reverse . takeWhile (/='.') . reverse . dropWhile (/='.')

@@ -0,0 +1,639 @@+{-# LANGUAGE CPP #-}+{-|++A reader for hledger's (and c++ ledger's) journal file format.++From the ledger 2.5 manual:++@+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.+@++-}++module Hledger.Read.Journal (+       tests_Journal,+       reader,+       journalFile,+       someamount,+       ledgeraccountname,+       ledgerExclamationDirective,+       ledgerHistoricalPrice,+       ledgerDefaultYear,+       emptyLine,+       ledgerdatetime,+)+where+import Control.Monad.Error (ErrorT(..), throwError, catchError)+import Text.ParserCombinators.Parsec hiding (parse)+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding (readFile, putStr, putStrLn, print, getContents)+import System.IO.UTF8+#endif+import Hledger.Data.Utils+import Hledger.Data.Types+import Hledger.Data.Dates+import Hledger.Data.AccountName (accountNameFromComponents,accountNameComponents)+import Hledger.Data.Amount+import Hledger.Data.Transaction+import Hledger.Data.Posting+import Hledger.Data.Journal+import Hledger.Data.Commodity (dollars,dollar,unknown,nonsimplecommoditychars)+import Hledger.Read.Common+++-- let's get to it++reader :: Reader+reader = Reader format detect parse++format :: String+format = "journal"++-- | Does the given file path and data provide hledger's journal file format ?+detect :: FilePath -> String -> Bool+detect f _ = fileSuffix f == format++-- | Parse and post-process a "Journal" from hledger's journal file+-- format, or give an error.+parse :: FilePath -> String -> ErrorT String IO Journal+parse = parseJournalWith journalFile++-- | Top-level journal parser. Returns a single composite, I/O performing,+-- error-raising "JournalUpdate" which can be applied to an empty journal+-- to get the final result.+journalFile :: GenParser Char JournalContext JournalUpdate+journalFile = do items <- many journalItem+                 eof+                 return $ liftM (foldr (.) id) $ sequence items+    where +      -- As all journal line types can be distinguished by the first+      -- character, excepting transactions versus empty (blank or+      -- comment-only) lines, can use choice w/o try+      journalItem = choice [ ledgerExclamationDirective+                          , liftM (return . addTransaction) ledgerTransaction+                          , liftM (return . addModifierTransaction) ledgerModifierTransaction+                          , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction+                          , liftM (return . addHistoricalPrice) ledgerHistoricalPrice+                          , ledgerDefaultYear+                          , ledgerIgnoredPriceCommodity+                          , ledgerTagDirective+                          , ledgerEndTagDirective+                          , emptyLine >> return (return id)+                          ] <?> "journal transaction or directive"++emptyLine :: GenParser Char st ()+emptyLine = do many spacenonewline+               optional $ (char ';' <?> "comment") >> many (noneOf "\n")+               newline+               return ()++ledgercomment :: GenParser Char st String+ledgercomment = do+  many1 $ char ';'+  many spacenonewline+  many (noneOf "\n")+  <?> "comment"++ledgercommentline :: GenParser Char st String+ledgercommentline = do+  many spacenonewline+  s <- ledgercomment+  optional newline+  eof+  return s+  <?> "comment"++ledgerExclamationDirective :: GenParser Char JournalContext JournalUpdate+ledgerExclamationDirective = do+  char '!' <?> "directive"+  directive <- many nonspace+  case directive of+    "include" -> ledgerInclude+    "account" -> ledgerAccountBegin+    "end"     -> ledgerAccountEnd+    _         -> mzero++ledgerInclude :: GenParser Char JournalContext JournalUpdate+ledgerInclude = do many1 spacenonewline+                   filename <- restofline+                   outerState <- getState+                   outerPos <- getPosition+                   let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"+                   return $ do contents <- expandPath outerPos filename >>= readFileE outerPos+                               case runParser journalFile outerState filename contents of+                                 Right l   -> l `catchError` (throwError . (inIncluded ++))+                                 Left perr -> throwError $ inIncluded ++ show perr+    where readFileE outerPos filename = ErrorT $ liftM Right (readFile filename) `catch` leftError+              where leftError err = return $ Left $ currentPos ++ whileReading ++ show err+                    currentPos = show outerPos+                    whileReading = " reading " ++ show filename ++ ":\n"++ledgerAccountBegin :: GenParser Char JournalContext JournalUpdate+ledgerAccountBegin = do many1 spacenonewline+                        parent <- ledgeraccountname+                        newline+                        pushParentAccount parent+                        return $ return id++ledgerAccountEnd :: GenParser Char JournalContext JournalUpdate+ledgerAccountEnd = popParentAccount >> return (return id)++ledgerModifierTransaction :: GenParser Char JournalContext ModifierTransaction+ledgerModifierTransaction = do+  char '=' <?> "modifier transaction"+  many spacenonewline+  valueexpr <- restofline+  postings <- ledgerpostings+  return $ ModifierTransaction valueexpr postings++ledgerPeriodicTransaction :: GenParser Char JournalContext PeriodicTransaction+ledgerPeriodicTransaction = do+  char '~' <?> "periodic transaction"+  many spacenonewline+  periodexpr <- restofline+  postings <- ledgerpostings+  return $ PeriodicTransaction periodexpr postings++ledgerHistoricalPrice :: GenParser Char JournalContext HistoricalPrice+ledgerHistoricalPrice = do+  char 'P' <?> "historical price"+  many spacenonewline+  date <- try (do {LocalTime d _ <- ledgerdatetime; return d}) <|> ledgerdate -- a time is ignored+  many1 spacenonewline+  symbol <- commoditysymbol+  many spacenonewline+  price <- someamount+  restofline+  return $ HistoricalPrice date symbol price++ledgerIgnoredPriceCommodity :: GenParser Char JournalContext JournalUpdate+ledgerIgnoredPriceCommodity = do+  char 'N' <?> "ignored-price commodity"+  many1 spacenonewline+  commoditysymbol+  restofline+  return $ return id++ledgerDefaultCommodity :: GenParser Char JournalContext JournalUpdate+ledgerDefaultCommodity = do+  char 'D' <?> "default commodity"+  many1 spacenonewline+  someamount+  restofline+  return $ return id++ledgerCommodityConversion :: GenParser Char JournalContext JournalUpdate+ledgerCommodityConversion = do+  char 'C' <?> "commodity conversion"+  many1 spacenonewline+  someamount+  many spacenonewline+  char '='+  many spacenonewline+  someamount+  restofline+  return $ return id++ledgerTagDirective :: GenParser Char JournalContext JournalUpdate+ledgerTagDirective = do+  string "tag" <?> "tag directive"+  many1 spacenonewline+  _ <- many1 nonspace+  restofline+  return $ return id++ledgerEndTagDirective :: GenParser Char JournalContext JournalUpdate+ledgerEndTagDirective = do+  string "end tag" <?> "end tag directive"+  restofline+  return $ return id++-- like ledgerAccountBegin, updates the JournalContext+ledgerDefaultYear :: GenParser Char JournalContext JournalUpdate+ledgerDefaultYear = do+  char 'Y' <?> "default year"+  many spacenonewline+  y <- many1 digit+  let y' = read y+  failIfInvalidYear y+  setYear y'+  return $ return id++-- | Try to parse a ledger entry. If we successfully parse an entry,+-- check it can be balanced, and fail if not.+ledgerTransaction :: GenParser Char JournalContext Transaction+ledgerTransaction = do+  date <- ledgerdate <?> "transaction"+  edate <- optionMaybe (ledgereffectivedate date) <?> "effective date"+  status <- ledgerstatus <?> "cleared flag"+  code <- ledgercode <?> "transaction code"+  (description, comment) <-+      (do {many1 spacenonewline; d <- liftM rstrip (many (noneOf ";\n")); c <- ledgercomment <|> return ""; newline; return (d, c)} <|>+       do {many spacenonewline; c <- ledgercomment <|> return ""; newline; return ("", c)}+      ) <?> "description and/or comment"+  postings <- ledgerpostings+  let t = txnTieKnot $ Transaction date edate status code description comment postings ""+  case balanceTransaction t of+    Right t' -> return t'+    Left err -> fail err++ledgerdate :: GenParser Char JournalContext Day+ledgerdate = choice' [ledgerfulldate, ledgerpartialdate] <?> "full or partial date"++ledgerfulldate :: GenParser Char JournalContext Day+ledgerfulldate = do+  (y,m,d) <- ymd+  return $ fromGregorian (read y) (read m) (read d)++-- | Match a partial M/D date in a ledger, and also require that a default+-- year directive was previously encountered.+ledgerpartialdate :: GenParser Char JournalContext Day+ledgerpartialdate = do+  (_,m,d) <- md+  y <- getYear+  when (isNothing y) $ fail "partial date found, but no default year specified"+  return $ fromGregorian (fromJust y) (read m) (read d)++ledgerdatetime :: GenParser Char JournalContext LocalTime+ledgerdatetime = do +  day <- ledgerdate+  many1 spacenonewline+  h <- many1 digit+  char ':'+  m <- many1 digit+  s <- optionMaybe $ do+      char ':'+      many1 digit+  let tod = TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)+  return $ LocalTime day tod++ledgereffectivedate :: Day -> GenParser Char JournalContext Day+ledgereffectivedate actualdate = do+  char '='+  -- kludgy way to use actual date for default year+  let withDefaultYear d p = do+        y <- getYear+        let (y',_,_) = toGregorian d in setYear y'+        r <- p+        when (isJust y) $ setYear $ fromJust y+        return r+  edate <- withDefaultYear actualdate ledgerdate+  return edate++ledgerstatus :: GenParser Char st Bool+ledgerstatus = try (do { many1 spacenonewline; char '*' <?> "status"; return True } ) <|> return False++ledgercode :: GenParser Char st String+ledgercode = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""++ledgerpostings :: GenParser Char JournalContext [Posting]+ledgerpostings = do+  -- complicated to handle intermixed comment lines.. please make me better.+  ctx <- getState+  let parses p = isRight . parseWithCtx ctx p+  -- parse the following non-comment whitespace-beginning lines as postings+  -- make sure the sub-parse starts from the current position, for useful errors+  pos <- getPosition+  ls <- many1 $ try linebeginningwithspaces+  let ls' = filter (not . (ledgercommentline `parses`)) ls+  when (null ls') $ fail "no postings"+  return $ map (fromparse . parseWithCtx ctx (setPosition pos >> ledgerposting)) ls'+  <?> "postings"++linebeginningwithspaces :: GenParser Char st String+linebeginningwithspaces = do+  sp <- many1 spacenonewline+  c <- nonspace+  cs <- restofline+  return $ sp ++ (c:cs) ++ "\n"++ledgerposting :: GenParser Char JournalContext Posting+ledgerposting = do+  many1 spacenonewline+  status <- ledgerstatus+  account <- transactionaccountname+  let (ptype, account') = (postingTypeFromAccountName account, unbracket account)+  amount <- postingamount+  many spacenonewline+  comment <- ledgercomment <|> return ""+  newline+  return (Posting status account' amount comment ptype Nothing)++-- qualify with the parent account from parsing context+transactionaccountname :: GenParser Char JournalContext AccountName+transactionaccountname = liftM2 (++) getParentAccount ledgeraccountname++-- | Parse an account name. Account names may have single spaces inside+-- them, and are terminated by two or more spaces. They should have one or+-- more components of at least one character, separated by the account+-- separator char.+ledgeraccountname :: GenParser Char st AccountName+ledgeraccountname = do+    a <- many1 (nonspace <|> singlespace)+    let a' = striptrailingspace a+    when (accountNameFromComponents (accountNameComponents a') /= a')+         (fail $ "accountname seems ill-formed: "++a')+    return a'+    where +      singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})+      -- couldn't avoid consuming a final space sometimes, harmless+      striptrailingspace s = if last s == ' ' then init s else s++-- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace+--     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"++-- | Parse an amount, with an optional left or right currency symbol and+-- optional price.+postingamount :: GenParser Char st MixedAmount+postingamount =+  try (do+        many1 spacenonewline+        someamount <|> return missingamt+      ) <|> return missingamt++someamount :: GenParser Char st MixedAmount+someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount ++leftsymbolamount :: GenParser Char st MixedAmount+leftsymbolamount = do+  sign <- optionMaybe $ string "-"+  let applysign = if isJust sign then negate else id+  sym <- commoditysymbol +  sp <- many spacenonewline+  (q,p,comma) <- amountquantity+  pri <- priceamount+  let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p}+  return $ applysign $ Mixed [Amount c q pri]+  <?> "left-symbol amount"++rightsymbolamount :: GenParser Char st MixedAmount+rightsymbolamount = do+  (q,p,comma) <- amountquantity+  sp <- many spacenonewline+  sym <- commoditysymbol+  pri <- priceamount+  let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p}+  return $ Mixed [Amount c q pri]+  <?> "right-symbol amount"++nosymbolamount :: GenParser Char st MixedAmount+nosymbolamount = do+  (q,p,comma) <- amountquantity+  pri <- priceamount+  let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p}+  return $ Mixed [Amount c q pri]+  <?> "no-symbol amount"++commoditysymbol :: GenParser Char st String+commoditysymbol = (quotedcommoditysymbol <|> simplecommoditysymbol) <?> "commodity symbol"++quotedcommoditysymbol :: GenParser Char st String+quotedcommoditysymbol = do+  char '"'+  s <- many1 $ noneOf ";\n\""+  char '"'+  return s++simplecommoditysymbol :: GenParser Char st String+simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)++priceamount :: GenParser Char st (Maybe MixedAmount)+priceamount =+    try (do+          many spacenonewline+          char '@'+          many spacenonewline+          a <- someamount -- XXX could parse more prices ad infinitum, shouldn't+          return $ Just a+          ) <|> return Nothing++-- gawd.. trying to parse a ledger number without error:++-- | Parse a ledger-style numeric quantity and also return the number of+-- digits to the right of the decimal point and whether thousands are+-- separated by comma.+amountquantity :: GenParser Char st (Double, Int, Bool)+amountquantity = do+  sign <- optionMaybe $ string "-"+  (intwithcommas,frac) <- numberparts+  let comma = ',' `elem` intwithcommas+  let precision = length frac+  -- read the actual value. We expect this read to never fail.+  let int = filter (/= ',') intwithcommas+  let int' = if null int then "0" else int+  let frac' = if null frac then "0" else frac+  let sign' = fromMaybe "" sign+  let quantity = read $ sign'++int'++"."++frac'+  return (quantity, precision, comma)+  <?> "commodity quantity"++-- | parse the two strings of digits before and after a possible decimal+-- point.  The integer part may contain commas, or either part may be+-- empty, or there may be no point.+numberparts :: GenParser Char st (String,String)+numberparts = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint++numberpartsstartingwithdigit :: GenParser Char st (String,String)+numberpartsstartingwithdigit = do+  let digitorcomma = digit <|> char ','+  first <- digit+  rest <- many digitorcomma+  frac <- try (do {char '.'; many digit}) <|> return ""+  return (first:rest,frac)+                     +numberpartsstartingwithpoint :: GenParser Char st (String,String)+numberpartsstartingwithpoint = do+  char '.'+  frac <- many1 digit+  return ("",frac)+                     ++tests_Journal = TestList [++   "ledgerTransaction" ~: do+    assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1+    assertBool "ledgerTransaction should not parse just a date"+                   $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n"+    assertBool "ledgerTransaction should require some postings"+                   $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n"+    let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"+    assertBool "ledgerTransaction should not include a comment in the description"+                   $ either (const False) ((== "a") . tdescription) t++  ,"ledgerModifierTransaction" ~: do+     assertParse (parseWithCtx emptyCtx ledgerModifierTransaction "= (some value expr)\n some:postings  1\n")++  ,"ledgerPeriodicTransaction" ~: do+     assertParse (parseWithCtx emptyCtx ledgerPeriodicTransaction "~ (some period expr)\n some:postings  1\n")++  ,"ledgerExclamationDirective" ~: do+     assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!include /some/file.x\n")+     assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!account some:account\n")+     assertParse (parseWithCtx emptyCtx (ledgerExclamationDirective >> ledgerExclamationDirective) "!account a\n!end\n")++  ,"ledgercommentline" ~: do+     assertParse (parseWithCtx emptyCtx ledgercommentline "; some comment \n")+     assertParse (parseWithCtx emptyCtx ledgercommentline " \t; x\n")+     assertParse (parseWithCtx emptyCtx ledgercommentline ";x")++  ,"ledgerDefaultYear" ~: do+     assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 2010\n")+     assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 10001\n")++  ,"ledgerHistoricalPrice" ~:+    assertParseEqual (parseWithCtx emptyCtx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55])++  ,"ledgerIgnoredPriceCommodity" ~: do+     assertParse (parseWithCtx emptyCtx ledgerIgnoredPriceCommodity "N $\n")++  ,"ledgerDefaultCommodity" ~: do+     assertParse (parseWithCtx emptyCtx ledgerDefaultCommodity "D $1,000.0\n")++  ,"ledgerCommodityConversion" ~: do+     assertParse (parseWithCtx emptyCtx ledgerCommodityConversion "C 1h = $50.00\n")++  ,"ledgerTagDirective" ~: do+     assertParse (parseWithCtx emptyCtx ledgerTagDirective "tag foo \n")++  ,"ledgerEndTagDirective" ~: do+     assertParse (parseWithCtx emptyCtx ledgerEndTagDirective "end tag \n")++  ,"ledgeraccountname" ~: do+    assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c")+    assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c")+    assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c")+    assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")++ ,"ledgerposting" ~: do+    assertParseEqual (parseWithCtx emptyCtx ledgerposting "  expenses:food:dining  $10.00\n") +                     (Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing)+    assertBool "ledgerposting parses a quoted commodity with numbers"+                   (isRight $ parseWithCtx emptyCtx ledgerposting "  a  1 \"DE123\"\n")++  ,"someamount" ~: do+     let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity+         assertMixedAmountParse parseresult mixedamount =+             (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)+     assertMixedAmountParse (parsewith someamount "1 @ $2")+                            (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])])++  ,"postingamount" ~: do+    assertParseEqual (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18])+    assertParseEqual (parseWithCtx emptyCtx postingamount " $1.")+                (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])++  ,"leftsymbolamount" ~: do+    assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "$1")+                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])+    assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "$-1")+                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])+    assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "-$1")+                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])++ ]++entry1_str = unlines+ ["2007/01/28 coopportunity"+ ,"    expenses:food:groceries                   $47.18"+ ,"    assets:checking                          $-47.18"+ ,""+ ]++entry1 =+    txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""+     [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing, +      Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting Nothing] ""+

@@ -0,0 +1,100 @@+{-# LANGUAGE CPP #-}+{-|++A reader for the timelog file format generated by timeclock.el.++From timeclock.el 2.6:++@+A timelog contains data in the form of a single entry per line.+Each entry has the form:++  CODE YYYY/MM/DD HH:MM:SS [COMMENT]++CODE is one of: b, h, i, o or O.  COMMENT is optional when the code is+i, o or O.  The meanings of the codes are:++  b  Set the current time balance, or \"time debt\".  Useful when+     archiving old log data, when a debt must be carried forward.+     The COMMENT here is the number of seconds of debt.++  h  Set the required working time for the given day.  This must+     be the first entry for that day.  The COMMENT in this case is+     the number of hours in this workday.  Floating point amounts+     are allowed.++  i  Clock in.  The COMMENT in this case should be the name of the+     project worked on.++  o  Clock out.  COMMENT is unnecessary, but can be used to provide+     a description of how the period went, for example.++  O  Final clock out.  Whatever project was being worked on, it is+     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.Timelog (+       tests_Timelog,+       reader,+)+where+import Control.Monad.Error (ErrorT(..))+import Text.ParserCombinators.Parsec hiding (parse)+import Hledger.Data+import Hledger.Read.Common+import Hledger.Read.Journal (ledgerExclamationDirective, ledgerHistoricalPrice,+                             ledgerDefaultYear, emptyLine, ledgerdatetime)+++reader :: Reader+reader = Reader format detect parse++format :: String+format = "timelog"++-- | Does the given file path and data provide timeclock.el's timelog format ?+detect :: FilePath -> String -> Bool+detect f _ = fileSuffix 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 :: FilePath -> String -> ErrorT String IO Journal+parse = parseJournalWith timelogFile++timelogFile :: GenParser Char JournalContext JournalUpdate+timelogFile = do items <- many timelogItem+                 eof+                 return $ liftM (foldr (.) id) $ sequence items+    where +      -- As all ledger line types can be distinguished by the first+      -- character, excepting transactions versus empty (blank or+      -- comment-only) lines, can use choice w/o try+      timelogItem = choice [ ledgerExclamationDirective+                          , liftM (return . addHistoricalPrice) ledgerHistoricalPrice+                          , ledgerDefaultYear+                          , emptyLine >> return (return id)+                          , liftM (return . addTimeLogEntry)  timelogentry+                          ] <?> "timelog entry, or default year or historical price directive"++-- | Parse a timelog entry.+timelogentry :: GenParser Char JournalContext TimeLogEntry+timelogentry = do+  code <- oneOf "bhioO"+  many1 spacenonewline+  datetime <- ledgerdatetime+  comment <- optionMaybe (many1 spacenonewline >> liftM2 (++) getParentAccount restofline)+  return $ TimeLogEntry (read [code]) datetime (maybe "" rstrip comment)++tests_Timelog = TestList [+ ]+

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.10+version: 0.11 category:       Finance synopsis:       Core types and utilities for working with hledger (or c++ ledger) data. description:@@ -25,6 +25,8 @@ --   sample.timelog  library+  -- should set patchlevel here as in Makefile+  cpp-options:    -DPATCHLEVEL=0   exposed-modules:                   Hledger.Data                   Hledger.Data.Account@@ -32,15 +34,17 @@                   Hledger.Data.Amount                   Hledger.Data.Commodity                   Hledger.Data.Dates-                  Hledger.Data.IO                   Hledger.Data.Transaction                   Hledger.Data.Journal                   Hledger.Data.Ledger                   Hledger.Data.Posting-                  Hledger.Data.Parse                   Hledger.Data.TimeLog                   Hledger.Data.Types                   Hledger.Data.Utils+                  Hledger.Read+                  Hledger.Read.Common+                  Hledger.Read.Journal+                  Hledger.Read.Timelog   Build-Depends:                   base >= 3 && < 5                  ,containers@@ -55,9 +59,6 @@                  ,time                  ,utf8-string >= 0.3                  ,HUnit--  -- should set patchlevel here as in Makefile-  cpp-options:    -DPATCHLEVEL=0  -- source-repository head --   type:     darcs