hledger 0.4 → 0.5

raw patch · 30 files changed

+1627/−864 lines, 30 filesdep +csvdep +regex-pcredep +splitdep ~utf8-stringPVP ok

version bump matches the API change (PVP)

Dependencies added: csv, regex-pcre, split

Dependency ranges changed: utf8-string

API changes (from Hackage documentation)

Files

• AddCommand.hs +228/−0
• BalanceCommand.hs +4/−2
• HistogramCommand.hs +50/−0
• Ledger.hs +6/−4
• Ledger/Account.hs +8/−3
• Ledger/AccountName.hs +1/−1
• Ledger/Amount.hs +10/−2
• Ledger/Entry.hs +0/−105
• Ledger/IO.hs +107/−0
• Ledger/Ledger.hs +110/−28
• Ledger/LedgerTransaction.hs +109/−0
• Ledger/Parse.hs +72/−77
• Ledger/Posting.hs +45/−0
• Ledger/RawLedger.hs +73/−63
• Ledger/RawTransaction.hs +0/−35
• Ledger/TimeLog.hs +34/−22
• Ledger/Transaction.hs +24/−11
• Ledger/Types.hs +67/−55
• Ledger/Utils.hs +12/−5
• Options.hs +79/−81
• PrintCommand.hs +10/−8
• README +46/−41
• RegisterCommand.hs +21/−27
• Tests.hs +400/−200
• UICommand.hs +13/−13
• Utils.hs +36/−39
• Version.hs +1/−1
• WebCommand.hs +13/−3
• hledger.cabal +13/−8
• hledger.hs +35/−30

@@ -0,0 +1,228 @@+{-| ++An add command to help with data entry.++-}++module AddCommand+where+import Prelude hiding (putStr, putStrLn, getLine, appendFile)+import Ledger+import Options+import RegisterCommand (showRegisterReport)+import System.IO.UTF8+import System.IO (stderr, hFlush)+import System.IO.Error+import Text.ParserCombinators.Parsec+import Utils (ledgerFromStringWithOpts)+++-- | Read ledger transactions from the terminal, prompting for each field,+-- and append them to the ledger file. If the ledger came from stdin, this+-- command has no effect.+add :: [Opt] -> [String] -> Ledger -> IO ()+add opts args l+    | filepath (rawledger l) == "-" = return ()+    | otherwise = do+  hPutStrLn stderr+    "Enter one or more transactions, which will be added to your ledger file.\n\+    \To complete a transaction, enter . as account name.\n\+    \To finish input, enter control-d (discards any transaction in progress)."+  getAndAddTransactions l args+  return ()++-- | Read a number of ledger transactions from the command line,+-- prompting, validating, displaying and appending them to the ledger+-- file, until end of input.+getAndAddTransactions :: Ledger -> [String] -> IO [LedgerTransaction]+getAndAddTransactions l args = do+  -- for now, thread the eoi flag throughout rather than muck about with monads+  (t, eoi) <- getTransaction l args+  l <- if isJust t then addTransaction l (fromJust t) else return l+  if eoi then return $ maybe [] (:[]) t+         else liftM (fromJust t:) (getAndAddTransactions l args)++-- | Get a transaction from the command line, if possible, and a flag+-- indicating end of input.+getTransaction :: Ledger -> [String] -> IO (Maybe LedgerTransaction, Bool)+getTransaction l args = do+  today <- getCurrentDay+  (datestr, eoi) <- askFor "date" +                        (Just $ showDate today)+                        (Just $ \s -> null s || +                          (isRight $ parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))+  if eoi+    then return (Nothing, True)+    else do+      (description, eoi) <- if null args +                           then askFor "description" Nothing (Just $ not . null) +                           else (do+                                  let description = unwords args+                                  hPutStrLn stderr $ "description: " ++ description+                                  return (description, False))+      if eoi+        then return (Nothing, True)+        else do+          let historymatches = transactionsSimilarTo l description+          when (not $ null historymatches) (do+                             hPutStrLn stderr "Similar past transactions found:"+                             hPutStr stderr $ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) $ take 3 historymatches)+          let bestmatch | null historymatches = Nothing+                        | otherwise = Just $ snd $ head $ historymatches+              bestmatchpostings = maybe Nothing (Just . ltpostings) bestmatch+              date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr+              getpostingsandvalidate = do+                             (ps, eoi) <- getPostings bestmatchpostings []+                             let t = nullledgertxn{ltdate=date+                                                  ,ltstatus=False+                                                  ,ltdescription=description+                                                  ,ltpostings=ps+                                                  }+                             if eoi && null ps+                               then return (Nothing, eoi)+                               else either (const retry) (return . flip (,) eoi . Just) $ balanceLedgerTransaction t+              retry = do+                hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:"+                getpostingsandvalidate+          getpostingsandvalidate++-- | Get two or more postings from the command line, if possible, and a+-- flag indicating end of input.+getPostings :: Maybe [Posting] -> [Posting] -> IO ([Posting], Bool)+getPostings bestmatchps enteredps = do+  (account, eoi) <- askFor (printf "account %d" n) defaultaccount validateaccount+  if account=="." || eoi+    then return (enteredps, eoi)+    else do+      (amountstr, eoi) <- askFor (printf "amount  %d" n) defaultamount validateamount+      let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr+      let p = nullrawposting{paccount=account,pamount=amount}+      if eoi+        then if null enteredps+               then return ([], True)+               else return (enteredps ++ [p], True)+        else if amount == missingamt+               then return $ (enteredps ++ [p], eoi)+               else getPostings bestmatchps $ enteredps ++ [p]+    where+      n = length enteredps + 1+      bestmatch | isNothing bestmatchps = Nothing+                | n <= length ps = Just $ ps !! (n-1)+                | otherwise = Nothing+                where Just ps = bestmatchps+      defaultaccount = maybe Nothing (Just . paccount) bestmatch+      validateaccount = Just $ \s -> not $ null s+      defaultamount | n==1 = maybe Nothing (Just . show . pamount) bestmatch -- previously used amount+                    | otherwise = Just $ show $ negate $ sum $ map pamount enteredps -- balancing amount+      validateamount = Just $ \s -> +                       (null s && (not $ null enteredps)) ||+                       (isRight $ parse (someamount>>many spacenonewline>>eof) "" s)+++-- | Prompt for and read a string value and a flag indicating whether+-- input has ended (control-d was pressed), optionally with a default+-- value and a validator.  A validator will cause the prompt to repeat+-- until the input is valid (unless the input is just ctrl-d).+askFor :: String -> Maybe String -> Maybe (String -> Bool) -> IO (String, Bool)+askFor prompt def validator = do+  hPutStr stderr $ prompt ++ (maybe "" showdef def) ++ ": "+  hFlush stderr+  -- ugly+  l <- getLine `catch` (\e -> if isEOFError e then return "*EOF*" else ioError e)+  let (l', eoi) = case l of "*EOF*" -> ("", True)+                            _       -> (l, False)+  let input = if null l' then fromMaybe l' def else l'+  case validator of+    Just valid -> if valid input || (null input && eoi)+                   then return (input, eoi) +                   else askFor prompt def validator+    Nothing -> return (input, eoi)+    where showdef s = " [" ++ s ++ "]"++-- | Append this transaction to the ledger's file. Also, to the ledger's+-- transaction list, but we don't bother updating the other fields - this+-- is enough to include new transactions in the history matching.+addTransaction :: Ledger -> LedgerTransaction -> IO Ledger+addTransaction l t = do+  appendToLedgerFile l $ show t+  putStrLn $ printf "\nAdded transaction to %s:" (filepath $ rawledger l)+  putStrLn =<< registerFromString (show t)+  return l{rawledger=rl{ledger_txns=ts}}+      where rl = rawledger l+            ts = ledger_txns rl ++ [t]++-- | Append data to the ledger's file, ensuring proper separation from any+-- existing data; or if the file is "-", dump it to stdout.+appendToLedgerFile :: Ledger -> String -> IO ()+appendToLedgerFile l s = +    if f == "-"+    then putStr $ sep ++ s+    else appendFile f $ sep++s+    where +      f = filepath $ rawledger l+      -- we keep looking at the original raw text from when the ledger+      -- was first read, but that's good enough for now+      t = rawledgertext l+      sep | null $ strip t = ""+          | otherwise = replicate (2 - min 2 (length lastnls)) '\n'+          where lastnls = takeWhile (=='\n') $ reverse t++-- | Convert a string of ledger data into a register report.+registerFromString :: String -> IO String+registerFromString s = do+  now <- getCurrentLocalTime+  l <- ledgerFromStringWithOpts [] [] now s+  return $ showRegisterReport [Empty] [] l++-- | Return a similarity measure, from 0 to 1, for two strings.+-- This is Simon White's letter pairs algorithm from+-- http://www.catalysoft.com/articles/StrikeAMatch.html+-- with a modification for short strings.+compareStrings :: String -> String -> Float+compareStrings "" "" = 1+compareStrings (a:[]) "" = 0+compareStrings "" (b:[]) = 0+compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0+compareStrings s1 s2 = 2.0 * (fromIntegral i) / (fromIntegral u)+    where+      i = length $ intersect pairs1 pairs2+      u = length pairs1 + length pairs2+      pairs1 = wordLetterPairs $ uppercase s1+      pairs2 = wordLetterPairs $ uppercase s2+wordLetterPairs = concatMap letterPairs . words+letterPairs (a:b:rest) = [a,b]:(letterPairs (b:rest))+letterPairs _ = []++compareLedgerDescriptions s t = compareStrings s' t'+    where s' = simplify s+          t' = simplify t+          simplify = filter (not . (`elem` "0123456789"))++transactionsSimilarTo :: Ledger -> String -> [(Float,LedgerTransaction)]+transactionsSimilarTo l s =+    sortBy compareRelevanceAndRecency+               $ filter ((> threshold).fst)+               $ [(compareLedgerDescriptions s $ ltdescription t, t) | t <- ts]+    where+      compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,ltdate t2) (n1,ltdate t1)+      ts = ledger_txns $ rawledger l+      threshold = 0++{- doctests++@+$ echo "2009/13/1"|hledger -f /dev/null add 2>&1|tail -1|sed -e's/\[[^]]*\]//g' # a bad date is not accepted+date : date : +@++@+$ echo|hledger -f /dev/null add 2>&1|tail -1|sed -e's/\[[^]]*\]//g' # a blank date is ok+date : description: +@++@+$ printf "\n\n"|hledger -f /dev/null add 2>&1|tail -1|sed -e's/\[[^]]*\]//g' # a blank description should fail+date : description: description: +@++-}

@@ -96,6 +96,7 @@  module BalanceCommand where+import Prelude hiding (putStr) import Ledger.Utils import Ledger.Types import Ledger.Amount@@ -105,6 +106,7 @@ import Ledger.Parse import Options import Utils+import System.IO.UTF8   -- | Print a balance report.@@ -125,7 +127,7 @@                | not (Empty `elem` opts) && isZeroMixedAmount total = ""                | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmount total           where-            total = sum $ map abalance $ topAccounts l+            total = sum $ map abalance $ ledgerTopAccounts l  -- | Display one line of the balance report with appropriate indenting and eliding. showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String@@ -155,5 +157,5 @@       numinterestingsubs = length $ filter isInterestingTree subtrees           where             isInterestingTree t = treeany (isInteresting opts l . aname) t-            subtrees = map (fromJust . ledgerAccountTreeAt l) $ subAccounts l $ ledgerAccount l a+            subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a 

@@ -0,0 +1,50 @@+{-| ++Print a histogram report.++-}++module HistogramCommand+where+import Prelude hiding (putStr)+import qualified Data.Map as Map+import Data.Map ((!))+import Ledger+import Options+import System.IO.UTF8+++barchar = '*'++-- | Print a histogram of some statistic per reporting interval, such as+-- number of transactions per day.+histogram :: [Opt] -> [String] -> Ledger -> IO ()+histogram opts args l = putStr $ showHistogram opts args l++showHistogram :: [Opt] -> [String] -> Ledger -> String+showHistogram opts args l = concatMap (printDayWith countBar) daytxns+    where+      i = intervalFromOpts opts+      interval | i == NoInterval = Daily+               | otherwise = i+      fullspan = rawLedgerDateSpan $ rawledger l+      days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan+      daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days]+      -- same as RegisterCommand+      ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l+      filterempties+          | Empty `elem` opts = id+          | otherwise = filter (not . isZeroMixedAmount . tamount)+      matchapats t = matchpats apats $ taccount t+      (apats,_) = parsePatternArgs args+      filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)+                  | otherwise = id+      depth = depthFromOpts opts++printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)++countBar ts = replicate (length ts) barchar++total ts = show $ sumTransactions ts++-- totalBar ts = replicate (sumTransactions ts) barchar

@@ -11,11 +11,12 @@                module Ledger.Amount,                module Ledger.Commodity,                module Ledger.Dates,-               module Ledger.Entry,+               module Ledger.IO,+               module Ledger.LedgerTransaction,                module Ledger.Ledger,                module Ledger.Parse,                module Ledger.RawLedger,-               module Ledger.RawTransaction,+               module Ledger.Posting,                module Ledger.TimeLog,                module Ledger.Transaction,                module Ledger.Types,@@ -27,11 +28,12 @@ import Ledger.Amount import Ledger.Commodity import Ledger.Dates-import Ledger.Entry+import Ledger.IO+import Ledger.LedgerTransaction import Ledger.Ledger import Ledger.Parse import Ledger.RawLedger-import Ledger.RawTransaction+import Ledger.Posting import Ledger.TimeLog import Ledger.Transaction import Ledger.Types

@@ -1,8 +1,13 @@ {-| -An 'Account' stores, for efficiency: an 'AccountName', all transactions in-the account (excluding subaccounts), and the account balance (including-subaccounts).+A compound data type for efficiency. An 'Account' stores++- an 'AccountName',++- all 'Transaction's (postings plus ledger transaction info) in the+  account, excluding subaccounts++- a 'MixedAmount' representing the account balance, including subaccounts.  -} 

@@ -145,4 +145,4 @@ abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat positivepats = filter (not . isnegativepat) negativepats = filter isnegativepat-matchregex pat str = containsRegex (mkRegexWithOpts pat True False) str+matchregex pat str = null pat || containsRegex (mkRegexWithOpts pat True False) str

@@ -126,9 +126,13 @@  -- | Does this amount appear to be zero when displayed with its given precision ? isZeroAmount :: Amount -> Bool-isZeroAmount a = nonzerodigits == ""-    where nonzerodigits = filter (`elem` "123456789") $ showAmount a+isZeroAmount a = null $ filter (`elem` "123456789") $ showAmount a +-- | 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 a = null $ filter (`elem` "123456789") $ printf "%.10f" $ quantity a+ -- | Access a mixed amount's components. amounts :: MixedAmount -> [Amount] amounts (Mixed as) = as@@ -137,6 +141,10 @@ -- containing only simple amounts which appear to be zero ? isZeroMixedAmount :: MixedAmount -> Bool isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount++-- | Is this mixed amount "really" zero ? See isReallyZeroAmount.+isReallyZeroMixedAmount :: MixedAmount -> Bool+isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmount  -- | MixedAmount derives Eq in Types.hs, but that doesn't know that we -- want $0 = EUR0 = 0. Yet we don't want to drag all this code in there.

@@ -1,105 +0,0 @@-{-|--An 'Entry' represents a regular entry in the ledger file. It normally-contains two or more balanced 'RawTransaction's.---}--module Ledger.Entry-where-import Ledger.Utils-import Ledger.Types-import Ledger.Dates-import Ledger.RawTransaction-import Ledger.Amount---instance Show Entry where show = showEntry--instance Show ModifierEntry where -    show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))--instance Show PeriodicEntry where -    show e = "~ " ++ (periodicexpr e) ++ "\n" ++ unlines (map show (p_transactions e))--nullentry = Entry {-              edate=parsedate "1900/1/1", -              estatus=False, -              ecode="", -              edescription="", -              ecomment="",-              etransactions=[],-              epreceding_comment_lines=""-            }--{-|-Show a ledger entry, formatted for the print command. ledger 2.x's-standard format looks like this:--@-yyyy/mm/dd[ *][ CODE] description.........          [  ; comment...............]-    account name 1.....................  ...$amount1[  ; comment...............]-    account name 2.....................  ..$-amount1[  ; comment...............]--pcodewidth    = no limit -- 10          -- mimicking ledger layout.-pdescwidth    = no limit -- 20          -- I don't remember what these mean,-pacctwidth    = 35 minimum, no maximum  -- they were important at the time.-pamtwidth     = 11-pcommentwidth = no limit -- 22-@--}-showEntry :: Entry -> String-showEntry = showEntry' True--showEntryUnelided :: Entry -> String-showEntryUnelided = showEntry' False--showEntry' :: Bool -> Entry -> String-showEntry' elide e = -    unlines $ [{-precedingcomment ++ -}description] ++ (showtxns $ etransactions e) ++ [""]-    where-      precedingcomment = epreceding_comment_lines e-      description = concat [date, status, code, desc] -- , comment]-      date = showdate $ edate e-      status = if estatus e then " *" else ""-      code = if (length $ ecode e) > 0 then (printf " (%s)" $ ecode e) else ""-      desc = " " ++ edescription e-      comment = if (length $ ecomment e) > 0 then "  ; "++(ecomment e) else ""-      showtxns ts-          | elide && length ts == 2 = [showtxn (ts !! 0), showtxnnoamt (ts !! 1)]-          | otherwise = map showtxn ts-      showtxn t = showacct t ++ "  " ++ (showamount $ tamount t) ++ (showcomment $ tcomment t)-      showtxnnoamt t = showacct t ++ "              " ++ (showcomment $ tcomment t)-      showacct t = "    " ++ showstatus t ++ (showaccountname $ taccount t)-      showamount = printf "%12s" . showMixedAmount-      showaccountname s = printf "%-34s" s-      showcomment s = if (length s) > 0 then "  ; "++s else ""-      showdate d = printf "%-10s" (showDate d)-      showstatus t = case tstatus t of-                       True -> "* "-                       False -> ""--isEntryBalanced :: Entry -> Bool-isEntryBalanced (Entry {etransactions=ts}) = -    isZeroMixedAmount $ costOfMixedAmount $ sum $ map tamount $ filter isReal ts---- | Ensure that this entry is balanced, possibly auto-filling a missing--- amount first. We can auto-fill if there is just one non-virtual--- transaction without an amount. The auto-filled balance will be--- converted to cost basis if possible. If the entry can not be balanced,--- return an error message instead.-balanceEntry :: Entry -> Either String Entry-balanceEntry e@Entry{etransactions=ts}-    | length missingamounts > 1 = Left $ showerr "could not balance this entry, too many missing amounts"-    | not $ isEntryBalanced e' = Left $ showerr "could not balance this entry, amounts do not balance"-    | otherwise = Right e'-    where-      (withamounts, missingamounts) = partition hasAmount $ filter isReal ts-      e' = e{etransactions=ts'}-      ts' | length missingamounts == 1 = map balance ts-          | otherwise = ts-          where -            balance t | isReal t && not (hasAmount t) = t{tamount = costOfMixedAmount (-otherstotal)}-                      | otherwise = t-                      where otherstotal = sum $ map tamount withamounts-      showerr s = printf "%s:\n%s" s (showEntryUnelided e)

@@ -0,0 +1,107 @@+{-|+Utilities for doing I/O with ledger files.+-}++module Ledger.IO+where+import Control.Monad.Error+import Data.Time.Clock+import Data.Time.LocalTime (LocalTime)+import Ledger.Ledger (cacheLedger)+import Ledger.Parse (parseLedger)+import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger)+import Ledger.Types (DateSpan(..),RawLedger,Ledger(..))+import Ledger.Utils (getCurrentLocalTime)+import System.Directory (getHomeDirectory)+import System.Environment (getEnv)+import System.IO+import Text.ParserCombinators.Parsec+import qualified Data.Map as Map (lookup)+++ledgerdefaultpath  = "~/.ledger"+timelogdefaultpath = "~/.timelog"+ledgerenvvar       = "LEDGER"+timelogenvvar      = "TIMELOG"++-- | A tuple of arguments specifying how to filter a raw ledger file:+-- +-- - only include transactions in this date span+-- +-- - only include if cleared\/uncleared\/don't care+-- +-- - only include if real\/don't care+-- +-- - convert all amounts to cost basis+-- +-- - only include if matching these account patterns+-- +-- - only include if matching these description patterns++type IOArgs = (DateSpan+              ,Maybe Bool+              ,Bool+              ,Bool+              ,[String]+              ,[String]+              )++noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], [])++-- | Get the user's default ledger file path.+myLedgerPath :: IO String+myLedgerPath = +    getEnv ledgerenvvar `catch` \_ -> return ledgerdefaultpath+  +-- | Get the user's default timelog file path.+myTimelogPath :: IO String+myTimelogPath =+    getEnv timelogenvvar `catch` \_ -> return timelogdefaultpath++-- | Read the user's default ledger file, or give an error.+myLedger :: IO Ledger+myLedger = myLedgerPath >>= readLedger++-- | Read the user's default timelog file, or give an error.+myTimelog :: IO Ledger+myTimelog = myTimelogPath >>= readLedger++-- | Read a ledger from this file, with no filtering, or give an error.+readLedger :: FilePath -> IO Ledger+readLedger f = tildeExpand f >>= readLedgerWithIOArgs noioargs++-- | Read a ledger from this file, filtering according to the io args,+-- | or give an error.+readLedgerWithIOArgs :: IOArgs -> FilePath -> IO Ledger+readLedgerWithIOArgs ioargs f = do+  t <- getCurrentLocalTime+  s <- readFile f +  rl <- rawLedgerFromString s+  return $ filterAndCacheLedger ioargs s rl++-- | Read a RawLedger from the given string, using the current time as+-- reference time, or give a parse error.+rawLedgerFromString :: String -> IO RawLedger+rawLedgerFromString s = do+  t <- getCurrentLocalTime+  liftM (either error id) $ runErrorT $ parseLedger t "(string)" s++-- | Convert a RawLedger to a canonicalised, cached and filtered Ledger.+filterAndCacheLedger :: IOArgs -> String -> RawLedger -> Ledger+filterAndCacheLedger (span,cleared,real,costbasis,apats,dpats) rawtext rl = +    (cacheLedger apats +    $ filterRawLedger span dpats cleared real +    $ canonicaliseAmounts costbasis rl+    ){rawledgertext=rawtext}++-- | 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,10 +1,54 @@ {-| -A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account-names, and a map from account names to 'Account's. It may also have had-uninteresting 'Entry's and 'Transaction's filtered out. It also stores-the complete ledger file text for the ui command.+A compound data type for efficiency. A 'Ledger' caches information derived+from a 'RawLedger' for easier querying. Also it typically has had+uninteresting 'LedgerTransaction's and 'Posting's filtered out. It+contains: +- the original unfiltered 'RawLedger'++- a tree of 'AccountName's++- a map from account names to 'Account's++- the full text of the journal file, when available++This is the main object you'll deal with as a user of the Ledger+library. The most useful functions also have shorter, lower-case+aliases for easier interaction. Here's an example:++> > import Ledger+> > l <- readLedger "sample.ledger"+> > accountnames l+> ["assets","assets:bank","assets:bank:checking","assets:bank:saving",...+> > accounts l+> [Account assets with 0 txns and $-1 balance,Account assets:bank with...+> > topaccounts l+> [Account assets with 0 txns and $-1 balance,Account expenses with...+> > account l "assets"+> Account assets with 0 txns and $-1 balance+> > accountsmatching ["ch"] l+> accountsmatching ["ch"] l+> [Account assets:bank:checking with 4 txns and $0 balance]+> > subaccounts l (account l "assets")+> subaccounts l (account l "assets")+> [Account assets:bank with 0 txns and $1 balance,Account assets:cash...+> > head $ transactions l+> 2008/01/01 income assets:bank:checking $1 RegularPosting+> > accounttree 2 l+> Node {rootLabel = Account top with 0 txns and 0 balance, subForest = [...+> > accounttreeat l (account l "assets")+> Just (Node {rootLabel = Account assets with 0 txns and $-1 balance, ...+> > datespan l+> DateSpan (Just 2008-01-01) (Just 2009-01-01)+> > rawdatespan l+> DateSpan (Just 2008-01-01) (Just 2009-01-01)+> > ledgeramounts l+> [$1,$-1,$1,$-1,$1,$-1,$1,$1,$-2,$1,$-1]+> > commodities l+> [Commodity {symbol = "$", side = L, spaced = False, comma = False, ...++ -}  module Ledger.Ledger@@ -18,14 +62,14 @@ import Ledger.Account import Ledger.Transaction import Ledger.RawLedger-import Ledger.Entry+import Ledger.LedgerTransaction   instance Show Ledger where-    show l = printf "Ledger with %d entries, %d accounts\n%s"-             ((length $ entries $ rawledger l) +-              (length $ modifier_entries $ rawledger l) +-              (length $ periodic_entries $ rawledger l))+    show l = printf "Ledger with %d transactions, %d accounts\n%s"+             ((length $ ledger_txns $ rawledger l) ++              (length $ modifier_txns $ rawledger l) ++              (length $ periodic_txns $ rawledger l))              (length $ accountnames l)              (showtree $ accountnametree l) @@ -48,7 +92,7 @@                                      (AccountName -> MixedAmount)) groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)     where-      txnanames = sort $ nub $ map account ts+      txnanames = sort $ nub $ map taccount ts       ant = accountNameTreeFrom $ expandAccountNames $ txnanames       allanames = flatten ant       txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])@@ -78,38 +122,38 @@ transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction] transactionsByAccount ts = m'     where-      sortedts = sortBy (comparing account) ts-      groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts-      m' = Map.fromList [(account $ head g, g) | g <- groupedts]+      sortedts = sortBy (comparing taccount) ts+      groupedts = groupBy (\t1 t2 -> taccount t1 == taccount t2) sortedts+      m' = Map.fromList [(taccount $ head g, g) | g <- groupedts] -- The special account name "top" can be used to look up all transactions. ? --      m' = Map.insert "top" sortedts m  filtertxns :: [String] -> [Transaction] -> [Transaction]-filtertxns apats ts = filter (matchpats apats . account) ts+filtertxns apats ts = filter (matchpats apats . taccount) ts  -- | List a ledger's account names.-accountnames :: Ledger -> [AccountName]-accountnames l = drop 1 $ flatten $ accountnametree l+ledgerAccountNames :: Ledger -> [AccountName]+ledgerAccountNames l = drop 1 $ flatten $ accountnametree l  -- | Get the named account from a ledger. ledgerAccount :: Ledger -> AccountName -> Account ledgerAccount l a = (accountmap l) ! a  -- | List a ledger's accounts, in tree order-accounts :: Ledger -> [Account]-accounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l+ledgerAccounts :: Ledger -> [Account]+ledgerAccounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l  -- | List a ledger's top-level accounts, in tree order-topAccounts :: Ledger -> [Account]-topAccounts l = map root $ branches $ ledgerAccountTree 9999 l+ledgerTopAccounts :: Ledger -> [Account]+ledgerTopAccounts l = map root $ branches $ ledgerAccountTree 9999 l  -- | Accounts in ledger whose name matches the pattern, in tree order.-accountsMatching :: [String] -> Ledger -> [Account]-accountsMatching pats l = filter (matchpats pats . aname) $ accounts l+ledgerAccountsMatching :: [String] -> Ledger -> [Account]+ledgerAccountsMatching pats l = filter (matchpats pats . aname) $ accounts l  -- | List a ledger account's immediate subaccounts-subAccounts :: Ledger -> Account -> [Account]-subAccounts l Account{aname=a} = +ledgerSubAccounts :: Ledger -> Account -> [Account]+ledgerSubAccounts l Account{aname=a} =      map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l  -- | List a ledger's transactions.@@ -124,10 +168,48 @@ ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account) ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l --- | The (explicit) date span containing all the ledger's transactions,--- or DateSpan Nothing Nothing if there are no transactions.+-- | The date span containing all the ledger's (filtered) transactions,+-- or DateSpan Nothing Nothing if there are none.+ledgerDateSpan :: Ledger -> DateSpan ledgerDateSpan l     | null ts = DateSpan Nothing Nothing-    | otherwise = DateSpan (Just $ date $ head ts) (Just $ addDays 1 $ date $ last ts)+    | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)     where-      ts = sortBy (comparing date) $ ledgerTransactions l+      ts = sortBy (comparing tdate) $ ledgerTransactions l++-- | Convenience aliases.+accountnames :: Ledger -> [AccountName]+accountnames = ledgerAccountNames++account :: Ledger -> AccountName -> Account+account = ledgerAccount++accounts :: Ledger -> [Account]+accounts = ledgerAccounts++topaccounts :: Ledger -> [Account]+topaccounts = ledgerTopAccounts++accountsmatching :: [String] -> Ledger -> [Account]+accountsmatching = ledgerAccountsMatching++subaccounts :: Ledger -> Account -> [Account]+subaccounts = ledgerSubAccounts++transactions :: Ledger -> [Transaction]+transactions = ledgerTransactions++accounttree :: Int -> Ledger -> Tree Account+accounttree = ledgerAccountTree++accounttreeat :: Ledger -> Account -> Maybe (Tree Account)+accounttreeat = ledgerAccountTreeAt++datespan :: Ledger -> DateSpan+datespan = ledgerDateSpan++rawdatespan :: Ledger -> DateSpan+rawdatespan = rawLedgerDateSpan . rawledger++ledgeramounts :: Ledger -> [MixedAmount]+ledgeramounts = rawLedgerAmounts . rawledger

@@ -0,0 +1,109 @@+{-|++A 'LedgerTransaction' represents a regular transaction in the ledger+file. It normally contains two or more balanced 'Posting's.++-}++module Ledger.LedgerTransaction+where+import Ledger.Utils+import Ledger.Types+import Ledger.Dates+import Ledger.Posting+import Ledger.Amount+++instance Show LedgerTransaction where show = showLedgerTransaction++instance Show ModifierTransaction where +    show t = "= " ++ (mtvalueexpr t) ++ "\n" ++ unlines (map show (mtpostings t))++instance Show PeriodicTransaction where +    show t = "~ " ++ (ptperiodicexpr t) ++ "\n" ++ unlines (map show (ptpostings t))++nullledgertxn :: LedgerTransaction+nullledgertxn = LedgerTransaction {+              ltdate=parsedate "1900/1/1", +              ltstatus=False, +              ltcode="", +              ltdescription="", +              ltcomment="",+              ltpostings=[],+              ltpreceding_comment_lines=""+            }++{-|+Show a ledger entry, formatted for the print command. ledger 2.x's+standard format looks like this:++@+yyyy/mm/dd[ *][ CODE] description.........          [  ; comment...............]+    account name 1.....................  ...$amount1[  ; comment...............]+    account name 2.....................  ..$-amount1[  ; comment...............]++pcodewidth    = no limit -- 10          -- mimicking ledger layout.+pdescwidth    = no limit -- 20          -- I don't remember what these mean,+pacctwidth    = 35 minimum, no maximum  -- they were important at the time.+pamtwidth     = 11+pcommentwidth = no limit -- 22+@+-}+showLedgerTransaction :: LedgerTransaction -> String+showLedgerTransaction = showLedgerTransaction' True++showLedgerTransactionUnelided :: LedgerTransaction -> String+showLedgerTransactionUnelided = showLedgerTransaction' False++showLedgerTransaction' :: Bool -> LedgerTransaction -> String+showLedgerTransaction' elide t = +    unlines $ [{-precedingcomment ++ -}description] ++ (showpostings $ ltpostings t) ++ [""]+    where+      precedingcomment = ltpreceding_comment_lines t+      description = concat [date, status, code, desc] -- , comment]+      date = showdate $ ltdate t+      status = if ltstatus t then " *" else ""+      code = if (length $ ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""+      desc = " " ++ ltdescription t+      comment = if (length $ ltcomment t) > 0 then "  ; "++(ltcomment t) else ""+      showdate d = printf "%-10s" (showDate d)+      showpostings ps+          | elide && length ps > 1 && isLedgerTransactionBalanced t+              = 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)+            showacct p = "    " ++ showstatus p ++ (showaccountname $ paccount p)+            showamount = printf "%12s" . showMixedAmount+            showaccountname s = printf "%-34s" s+            showcomment s = if (length s) > 0 then "  ; "++s else ""+            showstatus p = if pstatus p then "* " else ""++isLedgerTransactionBalanced :: LedgerTransaction -> Bool+isLedgerTransactionBalanced (LedgerTransaction {ltpostings=ps}) = +    all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount)+            [filter isReal ps, filter isBalancedVirtual ps]++-- | Ensure that this entry is balanced, possibly auto-filling a missing+-- amount first. We can auto-fill if there is just one non-virtual+-- transaction without an amount. The auto-filled balance will be+-- converted to cost basis if possible. If the entry can not be balanced,+-- return an error message instead.+balanceLedgerTransaction :: LedgerTransaction -> Either String LedgerTransaction+balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps}+    | length missingamounts > 1 = Left $ printerr "could not balance this transaction, too many missing amounts"+    | not $ isLedgerTransactionBalanced t' = Left $ printerr nonzerobalanceerror+    | otherwise = Right t'+    where+      (withamounts, missingamounts) = partition hasAmount $ filter isReal ps+      t' = t{ltpostings=ps'}+      ps' | length missingamounts == 1 = map balance ps+          | otherwise = ps+          where +            balance p | isReal p && not (hasAmount p) = p{pamount = costOfMixedAmount (-otherstotal)}+                      | otherwise = p+                      where otherstotal = sum $ map pamount withamounts+      printerr s = printf "%s:\n%s" s (showLedgerTransactionUnelided t)++nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero"

@@ -6,6 +6,7 @@  module Ledger.Parse where+import Prelude hiding (readFile, putStr, print) import Control.Monad import Control.Monad.Error import Text.ParserCombinators.Parsec@@ -14,7 +15,8 @@ import Text.ParserCombinators.Parsec.Combinator import qualified Text.ParserCombinators.Parsec.Token as P import System.Directory-import System.IO+import System.IO.UTF8+import System.IO (stdin) import qualified Data.Map as Map import Data.Time.LocalTime import Data.Time.Calendar@@ -22,7 +24,7 @@ import Ledger.Types import Ledger.Dates import Ledger.Amount-import Ledger.Entry+import Ledger.LedgerTransaction import Ledger.Commodity import Ledger.TimeLog import Ledger.RawLedger@@ -70,7 +72,7 @@  parseLedgerFile :: LocalTime -> FilePath -> ErrorT String IO RawLedger parseLedgerFile t "-" = liftIO (hGetContents stdin) >>= parseLedger t "-"-parseLedgerFile t f   = liftIO (readFile f)         >>= parseLedger t f+parseLedgerFile t f   = liftIO (readFile f) >>= parseLedger t f  -- | Parses the contents of a ledger file, or gives an error.  Requires -- the current (local) time to calculate any unfinished timelog sessions,@@ -81,26 +83,27 @@     Right m  -> liftM (rawLedgerConvertTimeLog reftime) $ m `ap` (return rawLedgerEmpty)     Left err -> throwError $ show err --- 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  ledgerFile :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))-ledgerFile = do entries <- many1 ledgerAnyEntry +ledgerFile = do items <- many ledgerItem                 eof-                return $ liftM (foldr1 (.)) $ sequence entries-    where ledgerAnyEntry = choice [ ledgerDirective-                                  , liftM (return . addEntry)         ledgerEntry-                                  , liftM (return . addModifierEntry) ledgerModifierEntry-                                  , liftM (return . addPeriodicEntry) ledgerPeriodicEntry-                                  , liftM (return . addHistoricalPrice) ledgerHistoricalPrice-                                  , ledgerDefaultYear-                                  , emptyLine >> return (return id)-                                  , liftM (return . addTimeLogEntry)  timelogentry-                                  ]+                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 [ ledgerDirective+                          , liftM (return . addLedgerTransaction) ledgerTransaction+                          , liftM (return . addModifierTransaction) ledgerModifierTransaction+                          , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction+                          , liftM (return . addHistoricalPrice) ledgerHistoricalPrice+                          , ledgerDefaultYear+                          , emptyLine >> return (return id)+                          , liftM (return . addTimeLogEntry)  timelogentry+                          ]  ledgerDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))-ledgerDirective = do char '!'+ledgerDirective = do char '!' <?> "directive"                      directive <- many nonspace                      case directive of                        "include" -> ledgerInclude@@ -249,7 +252,7 @@  emptyLine :: GenParser Char st () emptyLine = do many spacenonewline-               optional $ char ';' >> many (noneOf "\n")+               optional $ (char ';' <?> "comment") >> many (noneOf "\n")                newline                return () @@ -262,25 +265,25 @@         )      <|> return "" <?> "comment" -ledgerModifierEntry :: GenParser Char LedgerFileCtx ModifierEntry-ledgerModifierEntry = do-  char '=' <?> "modifier entry"+ledgerModifierTransaction :: GenParser Char LedgerFileCtx ModifierTransaction+ledgerModifierTransaction = do+  char '=' <?> "modifier transaction"   many spacenonewline   valueexpr <- restofline-  transactions <- ledgertransactions-  return $ ModifierEntry valueexpr transactions+  postings <- ledgerpostings+  return $ ModifierTransaction valueexpr postings -ledgerPeriodicEntry :: GenParser Char LedgerFileCtx PeriodicEntry-ledgerPeriodicEntry = do-  char '~' <?> "entry"+ledgerPeriodicTransaction :: GenParser Char LedgerFileCtx PeriodicTransaction+ledgerPeriodicTransaction = do+  char '~' <?> "periodic transaction"   many spacenonewline   periodexpr <- restofline-  transactions <- ledgertransactions-  return $ PeriodicEntry periodexpr transactions+  postings <- ledgerpostings+  return $ PeriodicTransaction periodexpr postings  ledgerHistoricalPrice :: GenParser Char LedgerFileCtx HistoricalPrice ledgerHistoricalPrice = do-  char 'P' <?> "hprice"+  char 'P' <?> "historical price"   many spacenonewline   date <- ledgerdate   many spacenonewline@@ -303,21 +306,18 @@  -- | Try to parse a ledger entry. If we successfully parse an entry, ensure it is balanced, -- and if we cannot, raise an error.-ledgerEntry :: GenParser Char LedgerFileCtx Entry-ledgerEntry = do-  date <- ledgerdate <?> "entry"+ledgerTransaction :: GenParser Char LedgerFileCtx LedgerTransaction+ledgerTransaction = do+  date <- ledgerdate <?> "transaction"   status <- ledgerstatus   code <- ledgercode--- ledger treats entry comments as part of the description, we will too---   desc <- many (noneOf ";\n") <?> "description"---   let description = reverse $ dropWhile (==' ') $ reverse desc-  description <- many (noneOf "\n") <?> "description"+  description <- liftM rstrip (many1 (noneOf ";\n") <?> "description")   comment <- ledgercomment   restofline-  transactions <- ledgertransactions-  let e = Entry date status code description comment transactions ""-  case balanceEntry e of-    Right e' -> return e'+  postings <- ledgerpostings+  let t = LedgerTransaction date status code description comment postings ""+  case balanceLedgerTransaction t of+    Right t' -> return t'     Left err -> error err  ledgerdate :: GenParser Char LedgerFileCtx Day@@ -353,52 +353,52 @@   return $ LocalTime day tod  ledgerstatus :: GenParser Char st Bool-ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> return False+ledgerstatus = try (do { char '*' <?> "status"; many1 spacenonewline; return True } ) <|> return False  ledgercode :: GenParser Char st String-ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return ""+ledgercode = try (do { char '(' <?> "code"; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return "" -ledgertransactions :: GenParser Char LedgerFileCtx [RawTransaction]-ledgertransactions = many $ try ledgertransaction+ledgerpostings :: GenParser Char LedgerFileCtx [Posting]+ledgerpostings = many1 $ try ledgerposting -ledgertransaction :: GenParser Char LedgerFileCtx RawTransaction-ledgertransaction = many1 spacenonewline >> choice [ normaltransaction, virtualtransaction, balancedvirtualtransaction ]+ledgerposting :: GenParser Char LedgerFileCtx Posting+ledgerposting = many1 spacenonewline >> choice [ normalposting, virtualposting, balancedvirtualposting ] -normaltransaction :: GenParser Char LedgerFileCtx RawTransaction-normaltransaction = do+normalposting :: GenParser Char LedgerFileCtx Posting+normalposting = do   status <- ledgerstatus   account <- transactionaccountname-  amount <- transactionamount+  amount <- postingamount   many spacenonewline   comment <- ledgercomment   restofline   parent <- getParentAccount-  return (RawTransaction status account amount comment RegularTransaction)+  return (Posting status account amount comment RegularPosting) -virtualtransaction :: GenParser Char LedgerFileCtx RawTransaction-virtualtransaction = do+virtualposting :: GenParser Char LedgerFileCtx Posting+virtualposting = do   status <- ledgerstatus   char '('   account <- transactionaccountname   char ')'-  amount <- transactionamount+  amount <- postingamount   many spacenonewline   comment <- ledgercomment   restofline   parent <- getParentAccount-  return (RawTransaction status account amount comment VirtualTransaction)+  return (Posting status account amount comment VirtualPosting) -balancedvirtualtransaction :: GenParser Char LedgerFileCtx RawTransaction-balancedvirtualtransaction = do+balancedvirtualposting :: GenParser Char LedgerFileCtx Posting+balancedvirtualposting = do   status <- ledgerstatus   char '['   account <- transactionaccountname   char ']'-  amount <- transactionamount+  amount <- postingamount   many spacenonewline   comment <- ledgercomment   restofline-  return (RawTransaction status account amount comment BalancedVirtualTransaction)+  return (Posting status account amount comment BalancedVirtualPosting)  -- Qualify with the parent account from parsing context transactionaccountname :: GenParser Char LedgerFileCtx AccountName@@ -417,14 +417,15 @@ accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)" -transactionamount :: GenParser Char st MixedAmount-transactionamount =+postingamount :: GenParser Char st MixedAmount+postingamount =   try (do         many1 spacenonewline         a <- someamount <|> return missingamt         return a       ) <|> return missingamt +someamount :: GenParser Char st MixedAmount someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount   leftsymbolamount :: GenParser Char st MixedAmount@@ -509,7 +510,7 @@   return ("",frac)                       -{-| Parse a timelog file. Here is the timelog grammar, from timeclock.el 2.6:+{-| Parse a timelog entry. Here is the timelog grammar from timeclock.el 2.6:  @ A timelog contains data in the form of a single entry per line.@@ -545,19 +546,13 @@ o 2007/03/10 17:26:02  -}-timelog :: GenParser Char LedgerFileCtx TimeLog-timelog = do-  entries <- many timelogentry <?> "timelog entry"-  eof-  return $ TimeLog entries- timelogentry :: GenParser Char LedgerFileCtx TimeLogEntry timelogentry = do   code <- oneOf "bhioO"   many1 spacenonewline   datetime <- ledgerdatetime   comment <- liftM2 (++) getParentAccount restofline-  return $ TimeLogEntry code datetime comment+  return $ TimeLogEntry (read [code]) datetime comment   -- misc parsing@@ -571,15 +566,15 @@   char '['   (y,m,d) <- smartdate   char ']'-  let edate = parsedate $ printf "%04s/%02s/%02s" y m d-  let matcher = \(Transaction{date=tdate}) -> +  let ltdate = parsedate $ printf "%04s/%02s/%02s" y m d+  let matcher = \(Transaction{tdate=d}) ->                    case op of-                    "<"  -> tdate <  edate-                    "<=" -> tdate <= edate-                    "="  -> tdate == edate-                    "==" -> tdate == edate -- just in case-                    ">=" -> tdate >= edate-                    ">"  -> tdate >  edate+                    "<"  -> d <  ltdate+                    "<=" -> d <= ltdate+                    "="  -> d == ltdate+                    "==" -> d == ltdate -- just in case+                    ">=" -> d >= ltdate+                    ">"  -> d >  ltdate   return matcher                compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]

@@ -0,0 +1,45 @@+{-|++A 'Posting' represents a 'MixedAmount' being added to or subtracted from a+single 'Account'.  Each 'LedgerTransaction' contains two or more postings+which should add up to 0.  ++Generally, we use these with the ledger transaction's date and description+added, which we call a 'Transaction'.++-}++module Ledger.Posting+where+import Ledger.Utils+import Ledger.Types+import Ledger.Amount+import Ledger.AccountName+++instance Show Posting where show = showPosting++nullrawposting = Posting False "" nullmixedamt "" RegularPosting++showPosting :: Posting -> String+showPosting (Posting s a amt _ ttype) = +    concatTopPadded [showaccountname a ++ " ", showamount amt]+    where+      showaccountname = printf "%-22s" . bracket . elideAccountName width+      (bracket,width) = case ttype of+                      BalancedVirtualPosting -> (\s -> "["++s++"]", 20)+                      VirtualPosting -> (\s -> "("++s++")", 20)+                      otherwise -> (id,22)+      showamount = padleft 12 . showMixedAmountOrZero++isReal :: Posting -> Bool+isReal p = ptype p == RegularPosting++isVirtual :: Posting -> Bool+isVirtual p = ptype p == VirtualPosting++isBalancedVirtual :: Posting -> Bool+isBalancedVirtual p = ptype p == BalancedVirtualPosting++hasAmount :: Posting -> Bool+hasAmount = (/= missingamt) . pamount

@@ -13,39 +13,40 @@ import Ledger.Types import Ledger.AccountName import Ledger.Amount-import Ledger.Entry+import Ledger.LedgerTransaction import Ledger.Transaction-import Ledger.RawTransaction+import Ledger.Posting import Ledger.TimeLog   instance Show RawLedger where-    show l = printf "RawLedger with %d entries, %d accounts: %s"-             ((length $ entries l) +-              (length $ modifier_entries l) +-              (length $ periodic_entries l))+    show l = printf "RawLedger with %d transactions, %d accounts: %s"+             ((length $ ledger_txns l) ++              (length $ modifier_txns l) ++              (length $ periodic_txns l))              (length accounts)              (show accounts)              -- ++ (show $ rawLedgerTransactions l)              where accounts = flatten $ rawLedgerAccountNameTree l  rawLedgerEmpty :: RawLedger-rawLedgerEmpty = RawLedger { modifier_entries = []-                           , periodic_entries = []-                           , entries = []+rawLedgerEmpty = RawLedger { modifier_txns = []+                           , periodic_txns = []+                           , ledger_txns = []                            , open_timelog_entries = []                            , historical_prices = []                            , final_comment_lines = []+                           , filepath = ""                            } -addEntry :: Entry -> RawLedger -> RawLedger-addEntry e l0 = l0 { entries = e : (entries l0) }+addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger+addLedgerTransaction t l0 = l0 { ledger_txns = t : (ledger_txns l0) } -addModifierEntry :: ModifierEntry -> RawLedger -> RawLedger-addModifierEntry me l0 = l0 { modifier_entries = me : (modifier_entries l0) }+addModifierTransaction :: ModifierTransaction -> RawLedger -> RawLedger+addModifierTransaction mt l0 = l0 { modifier_txns = mt : (modifier_txns l0) } -addPeriodicEntry :: PeriodicEntry -> RawLedger -> RawLedger-addPeriodicEntry pe l0 = l0 { periodic_entries = pe : (periodic_entries l0) }+addPeriodicTransaction :: PeriodicTransaction -> RawLedger -> RawLedger+addPeriodicTransaction pt l0 = l0 { periodic_txns = pt : (periodic_txns l0) }  addHistoricalPrice :: HistoricalPrice -> RawLedger -> RawLedger addHistoricalPrice h l0 = l0 { historical_prices = h : (historical_prices l0) }@@ -54,8 +55,8 @@ addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : (open_timelog_entries l0) }  rawLedgerTransactions :: RawLedger -> [Transaction]-rawLedgerTransactions = txnsof . entries-    where txnsof es = concat $ map flattenEntry $ zip es [1..]+rawLedgerTransactions = txnsof . ledger_txns+    where txnsof ts = concat $ map flattenLedgerTransaction $ zip ts [1..]  rawLedgerAccountNamesUsed :: RawLedger -> [AccountName] rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions@@ -66,58 +67,58 @@ rawLedgerAccountNameTree :: RawLedger -> Tree AccountName rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l --- | Remove ledger entries we are not interested in.+-- | Remove ledger transactions we are not interested in. -- Keep only those which fall between the begin and end dates, and match -- the description pattern, and are cleared or real if those options are active.-filterRawLedger :: DateSpan -> [String] -> Bool -> Bool -> RawLedger -> RawLedger+filterRawLedger :: DateSpan -> [String] -> Maybe Bool -> Bool -> RawLedger -> RawLedger filterRawLedger span pats clearedonly realonly = -    filterRawLedgerTransactionsByRealness realonly .-    filterRawLedgerEntriesByClearedStatus clearedonly .-    filterRawLedgerEntriesByDate span .-    filterRawLedgerEntriesByDescription pats+    filterRawLedgerPostingsByRealness realonly .+    filterRawLedgerTransactionsByClearedStatus clearedonly .+    filterRawLedgerTransactionsByDate span .+    filterRawLedgerTransactionsByDescription pats --- | Keep only entries whose description matches the description patterns.-filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger-filterRawLedgerEntriesByDescription pats (RawLedger ms ps es tls hs f) = -    RawLedger ms ps (filter matchdesc es) tls hs f-    where matchdesc = matchpats pats . edescription+-- | Keep only ledger transactions whose description matches the description patterns.+filterRawLedgerTransactionsByDescription :: [String] -> RawLedger -> RawLedger+filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f fp) = +    RawLedger ms ps (filter matchdesc ts) tls hs f fp+    where matchdesc = matchpats pats . ltdescription --- | Keep only entries which fall between begin and end dates. --- We include entries on the begin date and exclude entries on the end+-- | Keep only ledger 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.-filterRawLedgerEntriesByDate :: DateSpan -> RawLedger -> RawLedger-filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es tls hs f) = -    RawLedger ms ps (filter matchdate es) tls hs f+filterRawLedgerTransactionsByDate :: DateSpan -> RawLedger -> RawLedger+filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls hs f fp) = +    RawLedger ms ps (filter matchdate ts) tls hs f fp     where -      matchdate e = (maybe True (edate e>=) begin) && (maybe True (edate e<) end)+      matchdate t = (maybe True (ltdate t>=) begin) && (maybe True (ltdate t<) end) --- | Keep only entries with cleared status, if the flag is true, otherwise--- do no filtering.-filterRawLedgerEntriesByClearedStatus :: Bool -> RawLedger -> RawLedger-filterRawLedgerEntriesByClearedStatus False l = l-filterRawLedgerEntriesByClearedStatus True  (RawLedger ms ps es tls hs f) =-    RawLedger ms ps (filter estatus es) tls hs f+-- | Keep only ledger transactions which have the requested+-- cleared/uncleared status, if there is one.+filterRawLedgerTransactionsByClearedStatus :: Maybe Bool -> RawLedger -> RawLedger+filterRawLedgerTransactionsByClearedStatus Nothing rl = rl+filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps ts tls hs f fp) =+    RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f fp --- | Strip out any virtual transactions, if the flag is true, otherwise do+-- | Strip out any virtual postings, if the flag is true, otherwise do -- no filtering.-filterRawLedgerTransactionsByRealness :: Bool -> RawLedger -> RawLedger-filterRawLedgerTransactionsByRealness False l = l-filterRawLedgerTransactionsByRealness True (RawLedger ms ps es tls hs f) =-    RawLedger ms ps (map filtertxns es) tls hs f-    where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts}+filterRawLedgerPostingsByRealness :: Bool -> RawLedger -> RawLedger+filterRawLedgerPostingsByRealness False l = l+filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f fp) =+    RawLedger mts pts (map filtertxns ts) tls hs f fp+    where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps} --- | Strip out any transactions to accounts deeper than the specified depth--- (and any entries which have no transactions as a result).-filterRawLedgerTransactionsByDepth :: Int -> RawLedger -> RawLedger-filterRawLedgerTransactionsByDepth depth (RawLedger ms ps es tls hs f) =-    RawLedger ms ps (filter (not . null . etransactions) $ map filtertxns es) tls hs f-    where filtertxns e@Entry{etransactions=ts} = -              e{etransactions=filter ((<= depth) . accountNameLevel . taccount) ts}+-- | Strip out any postings to accounts deeper than the specified depth+-- (and any ledger transactions which have no postings as a result).+filterRawLedgerPostingsByDepth :: Int -> RawLedger -> RawLedger+filterRawLedgerPostingsByDepth depth (RawLedger mts pts ts tls hs f fp) =+    RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp+    where filtertxns t@LedgerTransaction{ltpostings=ps} = +              t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps} --- | Keep only entries which affect accounts matched by the account patterns.-filterRawLedgerEntriesByAccount :: [String] -> RawLedger -> RawLedger-filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls hs f) =-    RawLedger ms ps (filter (any (matchpats apats . taccount) . etransactions) es) tls hs f+-- | Keep only ledger transactions which affect accounts matched by the account patterns.+filterRawLedgerTransactionsByAccount :: [String] -> RawLedger -> RawLedger+filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f fp) =+    RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp  -- | Give all a ledger's amounts their canonical display settings.  That -- is, in each commodity, amounts will use the display settings of the@@ -125,10 +126,10 @@ -- detected. Also, amounts are converted to cost basis if that flag is -- active. canonicaliseAmounts :: Bool -> RawLedger -> RawLedger-canonicaliseAmounts costbasis l@(RawLedger ms ps es tls hs f) = RawLedger ms ps (map fixentry es) tls hs f+canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp     where -      fixentry (Entry d s c de co ts pr) = Entry d s c de co (map fixrawtransaction ts) pr-      fixrawtransaction (RawTransaction s ac a c t) = RawTransaction s ac (fixmixedamount a) c t+      fixledgertransaction (LedgerTransaction d s c de co ts pr) = LedgerTransaction d s c de co (map fixrawposting ts) pr+      fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t       fixmixedamount (Mixed as) = Mixed $ map fixamount as       fixamount = fixcommodity . (if costbasis then costOfAmount else id)       fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! (symbol $ commodity a)@@ -141,11 +142,11 @@       commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]       commoditieswithsymbol s = filter ((s==) . symbol) commodities       commoditysymbols = nub $ map symbol commodities-      commodities = map commodity $ concatMap (amounts . amount) $ rawLedgerTransactions l+      commodities = map commodity $ concatMap (amounts . tamount) $ rawLedgerTransactions l  -- | Get just the amounts from a ledger, in the order parsed. rawLedgerAmounts :: RawLedger -> [MixedAmount]-rawLedgerAmounts = map amount . rawLedgerTransactions+rawLedgerAmounts = map tamount . rawLedgerTransactions  -- | Get just the ammount commodities from a ledger, in the order parsed. rawLedgerCommodities :: RawLedger -> [Commodity]@@ -157,8 +158,17 @@  -- | Close any open timelog sessions using the provided current time. rawLedgerConvertTimeLog :: LocalTime -> RawLedger -> RawLedger-rawLedgerConvertTimeLog t l0 = l0 { entries = convertedTimeLog ++ entries l0+rawLedgerConvertTimeLog t l0 = l0 { ledger_txns = convertedTimeLog ++ ledger_txns l0                                   , open_timelog_entries = []                                   }     where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0 ++-- | The date span containing all the raw ledger's transactions,+-- or DateSpan Nothing Nothing if there are none.+rawLedgerDateSpan :: RawLedger -> DateSpan+rawLedgerDateSpan rl+    | null ts = DateSpan Nothing Nothing+    | otherwise = DateSpan (Just $ ltdate $ head ts) (Just $ addDays 1 $ ltdate $ last ts)+    where+      ts = sortBy (comparing ltdate) $ ledger_txns rl

@@ -1,35 +0,0 @@-{-|--A 'RawTransaction' represents a single transaction line within a ledger-entry. We call it raw to distinguish from the cached 'Transaction'.---}--module Ledger.RawTransaction-where-import Ledger.Utils-import Ledger.Types-import Ledger.Amount-import Ledger.AccountName---instance Show RawTransaction where show = showRawTransaction--nullrawtxn = RawTransaction False "" nullmixedamt "" RegularTransaction--showRawTransaction :: RawTransaction -> String-showRawTransaction (RawTransaction s a amt _ ttype) = -    concatTopPadded [showaccountname a ++ " ", showamount amt]-    where-      showaccountname = printf "%-22s" . bracket . elideAccountName width-      (bracket,width) = case ttype of-                      BalancedVirtualTransaction -> (\s -> "["++s++"]", 20)-                      VirtualTransaction -> (\s -> "("++s++")", 20)-                      otherwise -> (id,22)-      showamount = padleft 12 . showMixedAmountOrZero--isReal :: RawTransaction -> Bool-isReal t = rttype t == RegularTransaction--hasAmount :: RawTransaction -> Bool-hasAmount = (/= missingamt) . tamount

@@ -1,8 +1,8 @@ {-| -A 'TimeLog' is a parsed timelog file (see timeclock.el or the command-line-version) containing zero or more 'TimeLogEntry's. It can be converted to a-'RawLedger' for querying.+A 'TimeLogEntry' is a clock-in, clock-out, or other directive in a timelog+file (see timeclock.el or the command-line version). These can be+converted to 'LedgerTransactions' and queried like a ledger.  -} @@ -13,24 +13,36 @@ import Ledger.Dates import Ledger.Commodity import Ledger.Amount-import Ledger.Entry+import Ledger.LedgerTransaction  instance Show TimeLogEntry where      show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t) -instance Show TimeLog where-    show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl+instance Show TimeLogCode where +    show SetBalance = "b"+    show SetRequiredHours = "h"+    show In = "i"+    show Out = "o"+    show FinalOut = "O" --- | Convert time log entries to ledger entries. When there is no+instance Read TimeLogCode where +    readsPrec _ ('b' : xs) = [(SetBalance, xs)]+    readsPrec _ ('h' : xs) = [(SetRequiredHours, xs)]+    readsPrec _ ('i' : xs) = [(In, xs)]+    readsPrec _ ('o' : xs) = [(Out, xs)]+    readsPrec _ ('O' : xs) = [(FinalOut, xs)]+    readsPrec _ _ = []++-- | Convert time log entries to ledger 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.-entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Entry]+entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [LedgerTransaction] entriesFromTimeLogEntries _ [] = [] entriesFromTimeLogEntries now [i]     | odate > idate = [entryFromTimeLogInOut i o'] ++ entriesFromTimeLogEntries now [i',o]     | otherwise = [entryFromTimeLogInOut i o]     where-      o = TimeLogEntry 'o' end ""+      o = TimeLogEntry Out end ""       end = if itime > now then itime else now       (itime,otime) = (tldatetime i,tldatetime o)       (idate,odate) = (localDay itime,localDay otime)@@ -48,20 +60,20 @@ -- | Convert a timelog clockin and clockout entry to an equivalent ledger -- entry, representing the time expenditure. Note this entry is  not balanced, -- since we omit the \"assets:time\" transaction for simpler output.-entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Entry+entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> LedgerTransaction entryFromTimeLogInOut i o-    | otime >= itime = e+    | otime >= itime = t     | otherwise = -        error $ "clock-out time less than clock-in time in:\n" ++ showEntry e+        error $ "clock-out time less than clock-in time in:\n" ++ showLedgerTransaction t     where-      e = Entry {-            edate         = idate,-            estatus       = True,-            ecode         = "",-            edescription  = showtime itod ++ "-" ++ showtime otod,-            ecomment      = "",-            etransactions = txns,-            epreceding_comment_lines=""+      t = LedgerTransaction {+            ltdate         = idate,+            ltstatus       = True,+            ltcode         = "",+            ltdescription  = showtime itod ++ "-" ++ showtime otod,+            ltcomment      = "",+            ltpostings = ps,+            ltpreceding_comment_lines=""           }       showtime = take 5 . show       acctname = tlcomment i@@ -73,6 +85,6 @@       odate    = localDay otime       hrs      = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc       amount   = Mixed [hours hrs]-      txns     = [RawTransaction False acctname amount "" RegularTransaction-                 --,RawTransaction "assets:time" (-amount) "" RegularTransaction+      ps       = [Posting False acctname amount "" RegularPosting+                 --,Posting "assets:time" (-amount) "" RegularPosting                  ]

@@ -1,17 +1,21 @@ {-| -A 'Transaction' is a 'RawTransaction' with its parent 'Entry' \'s date and-description attached. These are what we actually query when doing reports.+A compound data type for efficiency. A 'Transaction' is a 'Posting' with+its parent 'LedgerTransaction' \'s date and description attached. The+\"transaction\" term is pretty ingrained in the code, docs and with users,+so we've kept it. These are what we work with most of the time when doing+reports.  -}  module Ledger.Transaction where+import Ledger.Dates import Ledger.Utils import Ledger.Types import Ledger.Dates-import Ledger.Entry-import Ledger.RawTransaction+import Ledger.LedgerTransaction+import Ledger.Posting import Ledger.Amount  @@ -22,17 +26,26 @@     s ++ unwords [showDate d,desc,a,show amt,show ttype]     where s = if stat then " *" else "" --- | Convert a 'Entry' to two or more 'Transaction's. An id number+-- | Convert a 'LedgerTransaction' to two or more 'Transaction's. An id number -- is attached to the transactions to preserve their grouping - it should -- be unique per entry.-flattenEntry :: (Entry, Int) -> [Transaction]-flattenEntry (Entry d s _ desc _ ts _, e) = -    [Transaction e s d desc (taccount t) (tamount t) (rttype t) | t <- ts]+flattenLedgerTransaction :: (LedgerTransaction, Int) -> [Transaction]+flattenLedgerTransaction (LedgerTransaction d s _ desc _ ps _, n) = +    [Transaction n s d desc (paccount p) (pamount p) (ptype p) | p <- ps]  accountNamesFromTransactions :: [Transaction] -> [AccountName]-accountNamesFromTransactions ts = nub $ map account ts+accountNamesFromTransactions ts = nub $ map taccount ts  sumTransactions :: [Transaction] -> MixedAmount-sumTransactions = sum . map amount+sumTransactions = sum . map tamount -nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularTransaction+nulltxn :: Transaction+nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting++-- | Does the given transaction fall within the given date span ?+isTransactionInDateSpan :: DateSpan -> Transaction -> Bool+isTransactionInDateSpan (DateSpan Nothing Nothing)   _ = True+isTransactionInDateSpan (DateSpan Nothing (Just e))  (Transaction{tdate=d}) = d<e+isTransactionInDateSpan (DateSpan (Just b) Nothing)  (Transaction{tdate=d}) = d>=b+isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{tdate=d}) = d>=b && d<e+

@@ -1,9 +1,25 @@ {-| -This is the next layer up from Ledger.Utils. All main data types are-defined here to avoid import cycles; see the corresponding modules for-documentation.+Most data types are defined here to avoid import cycles. See the+corresponding modules for each type's documentation. +A note about entry\/transaction\/posting terminology:++  - ledger 2 had Entrys containing Transactions.+  +  - hledger 0.4 had Entrys containing RawTransactions, plus Transactions+    which were a RawTransaction with its parent Entry's info added.+    The latter are what we most work with when reporting and are+    ubiquitous in the code and docs.+  +  - ledger 3 has Transactions containing Postings.+  ++  - hledger 0.5 has LedgerTransactions containing Postings, plus+    Transactions as before (a Posting plus it's parent's info).  The+    \"transaction\" term is pretty ingrained in the code, docs and with+    users, so we've kept it. + -}  module Ledger.Types @@ -25,7 +41,6 @@  data Commodity = Commodity {       symbol :: String,  -- ^ the commodity's symbol-       -- display preferences for amounts of this commodity       side :: Side,      -- ^ should the symbol appear on the left or the right       spaced :: Bool,    -- ^ should there be a space between symbol and quantity@@ -41,79 +56,76 @@  newtype MixedAmount = Mixed [Amount] deriving (Eq) -data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtualTransaction-                       deriving (Eq,Show)+data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting+                   deriving (Eq,Show) -data RawTransaction = RawTransaction {-      tstatus :: Bool,-      taccount :: AccountName,-      tamount :: MixedAmount,-      tcomment :: String,-      rttype :: TransactionType+data Posting = Posting {+      pstatus :: Bool,+      paccount :: AccountName,+      pamount :: MixedAmount,+      pcomment :: String,+      ptype :: PostingType     } deriving (Eq) --- | a ledger "modifier" entry. Currently ignored.-data ModifierEntry = ModifierEntry {-      valueexpr :: String,-      m_transactions :: [RawTransaction]+data ModifierTransaction = ModifierTransaction {+      mtvalueexpr :: String,+      mtpostings :: [Posting]     } deriving (Eq) --- | a ledger "periodic" entry. Currently ignored.-data PeriodicEntry = PeriodicEntry {-      periodicexpr :: String,-      p_transactions :: [RawTransaction]+data PeriodicTransaction = PeriodicTransaction {+      ptperiodicexpr :: String,+      ptpostings :: [Posting]     } deriving (Eq) -data Entry = Entry {-      edate :: Day,-      estatus :: Bool,-      ecode :: String,-      edescription :: String,-      ecomment :: String,-      etransactions :: [RawTransaction],-      epreceding_comment_lines :: String+data LedgerTransaction = LedgerTransaction {+      ltdate :: Day,+      ltstatus :: Bool,+      ltcode :: String,+      ltdescription :: String,+      ltcomment :: String,+      ltpostings :: [Posting],+      ltpreceding_comment_lines :: String     } deriving (Eq) -data HistoricalPrice = HistoricalPrice {-     hdate :: Day,-     hsymbol1 :: String,-     hsymbol2 :: String,-     hprice :: Double-} deriving (Eq,Show)--data RawLedger = RawLedger {-      modifier_entries :: [ModifierEntry],-      periodic_entries :: [PeriodicEntry],-      entries :: [Entry],-      open_timelog_entries :: [TimeLogEntry],-      historical_prices :: [HistoricalPrice],-      final_comment_lines :: String-    } deriving (Eq)+data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord)   data TimeLogEntry = TimeLogEntry {-      tlcode :: Char,+      tlcode :: TimeLogCode,       tldatetime :: LocalTime,       tlcomment :: String     } deriving (Eq,Ord) -data TimeLog = TimeLog {-      timelog_entries :: [TimeLogEntry]+data HistoricalPrice = HistoricalPrice {+      hdate :: Day,+      hsymbol1 :: String,+      hsymbol2 :: String,+      hprice :: Double+    } deriving (Eq,Show)++data RawLedger = RawLedger {+      modifier_txns :: [ModifierTransaction],+      periodic_txns :: [PeriodicTransaction],+      ledger_txns :: [LedgerTransaction],+      open_timelog_entries :: [TimeLogEntry],+      historical_prices :: [HistoricalPrice],+      final_comment_lines :: String,+      filepath :: FilePath     } deriving (Eq)  data Transaction = Transaction {-      entryno :: Int,-      status :: Bool,-      date :: Day,-      description :: String,-      account :: AccountName,-      amount :: MixedAmount,-      ttype :: TransactionType+      tnum :: Int,+      tstatus :: Bool,           -- ^ posting status+      tdate :: Day,              -- ^ ledger transaction date+      tdescription :: String,    -- ^ ledger transaction description+      taccount :: AccountName,   -- ^ posting account+      tamount :: MixedAmount,    -- ^ posting amount+      ttype :: PostingType       -- ^ posting type     } deriving (Eq)  data Account = Account {       aname :: AccountName,-      atransactions :: [Transaction],-      abalance :: MixedAmount+      atransactions :: [Transaction], -- ^ transactions in this account+      abalance :: MixedAmount         -- ^ sum of transactions in this account and subaccounts     }  data Ledger = Ledger {

@@ -1,8 +1,7 @@ {-| -This is the bottom of the module hierarchy. It provides a number of-standard modules and utilities which are useful everywhere (or, are needed-low in the hierarchy). The "hledger prelude".+Provide standard imports and utilities which are useful everywhere, or+needed low in the module hierarchy. This is the bottom of the dependency graph.  -} @@ -24,7 +23,9 @@ module Test.HUnit, ) where+import Prelude hiding (readFile) import Char+import Control.Exception import Control.Monad import Data.List --import qualified Data.Map as Map@@ -35,6 +36,7 @@ import Data.Time.Calendar import Data.Time.LocalTime import Debug.Trace+import System.IO.UTF8 import Test.HUnit import Text.Printf import Text.Regex@@ -46,7 +48,10 @@ lowercase = map toLower uppercase = map toUpper -strip = dropws . reverse . dropws . reverse where dropws = dropWhile (`elem` " \t")+strip = lstrip . rstrip+lstrip = dropws+rstrip = reverse . dropws . reverse+dropws = dropWhile (`elem` " \t")  elideLeft width s =     case length s > width of@@ -241,7 +246,7 @@   tz <- getCurrentTimeZone   return $ utcToLocalTime tz t -+-- misc  isLeft :: Either a b -> Bool isLeft (Left _) = True@@ -250,3 +255,5 @@ isRight :: Either a b -> Bool isRight = not . isLeft +strictReadFile :: FilePath -> IO String+strictReadFile f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s

@@ -1,77 +1,84 @@ {-# OPTIONS_GHC -cpp #-}+{-|+Command-line options for the application.+-}+ module Options  where import System import System.Console.GetOpt-import System.Directory import System.Environment import Text.Printf import Text.RegexPR (gsubRegexPRBy) import Data.Char (toLower)+import Ledger.IO (IOArgs,+                  ledgerenvvar,ledgerdefaultpath,myLedgerPath,+                  timelogenvvar,timelogdefaultpath,myTimelogPath) import Ledger.Parse import Ledger.Utils import Ledger.Types import Ledger.Dates+import Codec.Binary.UTF8.String (decodeString)+import Control.Monad (liftM)  progname      = "hledger"-ledgerpath    = "~/.ledger"-ledgerenvvar  = "LEDGER" timeprogname  = "hours"-timelogpath   = "~/.timelog"-timelogenvvar = "TIMELOG" -usagehdr = printf (-  "Usage: one of\n" ++-  "  %s [OPTIONS] COMMAND [PATTERNS]\n" ++-  "  %s [OPTIONS] [PERIOD [COMMAND [PATTERNS]]]\n" +++usagehdr = (+  "Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]\n" +++  "       hours   [OPTIONS] [COMMAND [PATTERNS]]\n" +++  "       hledger convert CSVFILE ACCOUNTNAME RULESFILE\n" ++   "\n" +++  "hledger uses your ~/.ledger or $LEDGER file (or another specified with -f),\n" +++  "while hours uses your ~/.timelog or $TIMELOG file.\n" +++  "\n" ++   "COMMAND is one of (may be abbreviated):\n" ++-  "  balance  - show account balances\n" ++-  "  print    - show formatted ledger entries\n" ++-  "  register - show register transactions\n" +++  "  add       - prompt for new transactions and add them to the ledger\n" +++  "  balance   - show accounts, with balances\n" +++  "  convert   - convert CSV data to ledger format and print on stdout\n" +++  "  histogram - show transaction counts per day or other interval\n" +++  "  print     - show transactions in ledger format\n" +++  "  register  - show transactions as a register with running balance\n" ++ #ifdef VTY-  "  ui       - run a simple curses-based text ui\n" +++  "  ui        - run a simple curses-based text ui\n" ++ #endif #ifdef HAPPS-  "  web      - run a simple web ui\n" +++  "  web       - run a simple web ui\n" ++ #endif-  "  test     - run self-tests\n" +++  "  test      - run self-tests\n" ++   "\n" ++   "PATTERNS are regular expressions which filter by account name.\n" ++-  "Or, prefix with desc: to filter by entry description.\n" ++-  "Or, prefix with not: to negate a pattern. (When using both, not: comes last.)\n" +++  "Prefix with desc: to filter by transaction description instead.\n" +++  "Prefix with not: to negate a pattern. When using both, not: comes last.\n" ++   "\n" ++-  "Dates can be y/m/d or ledger-style smart dates like \"last month\".\n" +++  "DATES can be y/m/d or ledger-style smart dates like \"last month\".\n" ++   "\n" ++   "Options:"-  ) progname timeprogname-  --usageftr = printf (-  "\n"   )-+usageftr = "" usage = usageInfo usagehdr options ++ usageftr  -- | Command-line options we accept. options :: [OptDescr Opt] options = [-  Option ['f'] ["file"]         (ReqArg File "FILE")   filehelp- ,Option ['b'] ["begin"]        (ReqArg Begin "DATE")  "report on entries on or after this date"- ,Option ['e'] ["end"]          (ReqArg End "DATE")    "report on entries prior to this date"- ,Option ['p'] ["period"]       (ReqArg Period "EXPR") ("report on entries during the specified period\n" +++  Option ['f'] ["file"]         (ReqArg File "FILE")   "use a different ledger/timelog file; - means stdin"+ ,Option ['b'] ["begin"]        (ReqArg Begin "DATE")  "report on transactions on or after this date"+ ,Option ['e'] ["end"]          (ReqArg End "DATE")    "report on transactions before this date"+ ,Option ['p'] ["period"]       (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++                                                        "and/or with the specified reporting interval\n")- ,Option ['C'] ["cleared"]      (NoArg  Cleared)       "report only on cleared entries"+ ,Option ['C'] ["cleared"]      (NoArg  Cleared)       "report only on cleared transactions"+ ,Option ['U'] ["uncleared"]    (NoArg  UnCleared)     "report only on uncleared transactions"  ,Option ['B'] ["cost","basis"] (NoArg  CostBasis)     "report cost of commodities"  ,Option []    ["depth"]        (ReqArg Depth "N")     "hide accounts/transactions deeper than this"- ,Option ['d'] ["display"]      (ReqArg Display "EXPR") ("show only transactions matching simple EXPR\n" ++-                                                        "(where EXPR is 'dOP[DATE]', OP is <, <=, =, >=, >)")+ ,Option ['d'] ["display"]      (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" +++                                                        "EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)")  ,Option ['E'] ["empty"]        (NoArg  Empty)         "show empty/zero things which are normally elided"  ,Option ['R'] ["real"]         (NoArg  Real)          "report only on real (non-virtual) transactions"  ,Option []    ["no-total"]     (NoArg  NoTotal)       "balance report: hide the final total" -- ,Option ['s'] ["subtotal"]     (NoArg  SubTotal)      "balance report: show subaccounts"  ,Option ['W'] ["weekly"]       (NoArg  WeeklyOpt)     "register report: show weekly summary"  ,Option ['M'] ["monthly"]      (NoArg  MonthlyOpt)    "register report: show monthly summary"+ ,Option ['Q'] ["quarterly"]    (NoArg  QuarterlyOpt)  "register report: show quarterly summary"  ,Option ['Y'] ["yearly"]       (NoArg  YearlyOpt)     "register report: show yearly summary"  ,Option ['h'] ["help"] (NoArg  Help)                  "show this help"  ,Option ['V'] ["version"]      (NoArg  Version)       "show version information"@@ -79,11 +86,6 @@  ,Option []    ["debug"]        (NoArg  Debug)         "show some debug output"  ,Option []    ["debug-no-ui"]  (NoArg  DebugNoUI)     "run ui commands with no output"  ]-    where -      filehelp = printf (intercalate "\n"-                         ["ledger file; default is the %s env. variable's"-                         ,"value, or %s. - means use standard input."-                         ]) ledgerenvvar ledgerpath  -- | An option value from a command-line flag. data Opt = @@ -92,6 +94,7 @@     End     {value::String} |      Period  {value::String} |      Cleared | +    UnCleared |      CostBasis |      Depth   {value::String} |      Display {value::String} | @@ -101,6 +104,7 @@     SubTotal |     WeeklyOpt |     MonthlyOpt |+    QuarterlyOpt |     YearlyOpt |     Help |     Verbose |@@ -109,10 +113,13 @@     | DebugNoUI     deriving (Show,Eq) --- yow..+-- these make me nervous optsWithConstructor f opts = concatMap get opts     where get o = if f v == o then [o] else [] where v = value o +optsWithConstructors fs opts = concatMap get opts+    where get o = if any (\f -> f == o) fs then [o] else []+ optValuesForConstructor f opts = concatMap get opts     where get o = if f v == o then [v] else [] where v = value o @@ -120,29 +127,19 @@     where get o = if any (\f -> f v == o) fs then [v] else [] where v = value o  -- | Parse the command-line arguments into options, command name, and--- command arguments. Any dates in the options are converted to full--- YYYY/MM/DD format, while we are in the IO monad and can get the current--- time. Arguments are parsed differently if the program was invoked as--- \"hours\".+-- command arguments. Any dates in the options are converted to explicit+-- YYYY/MM/DD format based on the current time. parseArguments :: IO ([Opt], String, [String]) parseArguments = do-  args <- getArgs-  istimequery <- usingTimeProgramName+  args <- liftM (map decodeString) getArgs   let (os,as,es) = getOpt Permute options args-  os' <- fixOptDates os-  case istimequery of-    False ->-        case (os,as,es) of-          (opts,cmd:args,[])   -> return (os',cmd,args)-          (opts,[],[])         -> return (os',"",[])-          (opts,_,errs)        -> ioError (userError (concat errs ++ usage))-    True -> -        case (os,as,es) of-          (opts,p:cmd:args,[]) -> return (os' ++ [Period p],cmd,args)-          (opts,p:args,[])     -> return ([Period p,SubTotal] ++ os',"balance",args)-          (opts,[],[])         -> return ([Period "today",SubTotal] ++ os',"balance",[])-          (opts,_,errs)        -> ioError (userError (concat errs ++ usage))-      +--  istimequery <- usingTimeProgramName+--  let os' = if istimequery then (Period "today"):os else os+  os'' <- fixOptDates os+  case (as,es) of+    (cmd:args,[])   -> return (os'',cmd,args)+    ([],[])         -> return (os'',"",[])+    (_,errs)        -> ioError (userError (concat errs ++ usage))  -- | Convert any fuzzy dates within these option values to explicit ones, -- based on today's date.@@ -183,10 +180,11 @@     | otherwise = case last otheropts of                     WeeklyOpt  -> Weekly                     MonthlyOpt -> Monthly+                    QuarterlyOpt -> Quarterly                     YearlyOpt  -> Yearly     where       popts = optValuesForConstructor Period opts-      otheropts = filter (`elem` [WeeklyOpt,MonthlyOpt,YearlyOpt]) opts +      otheropts = filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts       -- doesn't affect the interval, but parsePeriodExpr needs something       refdate = parsedate "0001/01/01" @@ -204,6 +202,12 @@       listtomaybe [] = Nothing       listtomaybe vs = Just $ last vs +-- | Get a maybe boolean representing the last cleared/uncleared option if any.+clearedValueFromOpts opts | null os = Nothing+                          | last os == Cleared = Just True+                          | otherwise = Just False+    where os = optsWithConstructors [Cleared,UnCleared] opts+ -- | Was the program invoked via the \"hours\" alias ? usingTimeProgramName :: IO Bool usingTimeProgramName = do@@ -214,34 +218,28 @@ ledgerFilePathFromOpts :: [Opt] -> IO String ledgerFilePathFromOpts opts = do   istimequery <- usingTimeProgramName-  let (e,d) = if istimequery-              then (timelogenvvar,timelogpath)-              else (ledgerenvvar,ledgerpath)-  envordefault <- getEnv e `catch` \_ -> return d-  paths <- mapM tildeExpand $ [envordefault] ++ optValuesForConstructor File opts-  return $ last paths---- | 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+  f <- if istimequery then myTimelogPath else myLedgerPath+  return $ last $ f:(optValuesForConstructor File opts) --- | Gather any pattern arguments into a list of account patterns and a--- list of description patterns. For now we interpret pattern arguments as+-- | Gather filter pattern arguments into a list of account patterns and a+-- list of description patterns. We interpret pattern arguments as -- follows: those prefixed with "desc:" are description patterns, all--- others are account patterns. Also patterns prefixed with "not:" are+-- others are account patterns; also patterns prefixed with "not:" are -- negated. not: should come after desc: if both are used.--- This is different from ledger 2 and 3.-parseAccountDescriptionArgs :: [Opt] -> [String] -> ([String],[String])-parseAccountDescriptionArgs opts args = (as, ds')+parsePatternArgs :: [String] -> ([String],[String])+parsePatternArgs args = (as, ds')     where       descprefix = "desc:"       (ds, as) = partition (descprefix `isPrefixOf`) args       ds' = map (drop (length descprefix)) ds++-- | Convert application options to more generic types for the library.+optsToIOArgs :: [Opt] -> [String] -> LocalTime -> IOArgs+optsToIOArgs opts args t = (dateSpanFromOpts (localDay t) opts+                         ,clearedValueFromOpts opts+                         ,Real `elem` opts+                         ,CostBasis `elem` opts+                         ,apats+                         ,dpats+                         ) where (apats,dpats) = parsePatternArgs args 

@@ -6,20 +6,22 @@  module PrintCommand where+import Prelude hiding (putStr) import Ledger import Options+import System.IO.UTF8  --- | Print ledger entries in standard format.+-- | Print ledger transactions in standard format. print' :: [Opt] -> [String] -> Ledger -> IO ()-print' opts args l = putStr $ showEntries opts args l+print' opts args l = putStr $ showLedgerTransactions opts args l -showEntries :: [Opt] -> [String] -> Ledger -> String-showEntries opts args l = concatMap showEntry $ filteredentries+showLedgerTransactions :: [Opt] -> [String] -> Ledger -> String+showLedgerTransactions opts args l = concatMap showLedgerTransaction $ filteredtxns     where -      filteredentries = entries $ -                        filterRawLedgerTransactionsByDepth depth $ -                        filterRawLedgerEntriesByAccount apats $ +      filteredtxns = ledger_txns $ +                        filterRawLedgerPostingsByDepth depth $ +                        filterRawLedgerTransactionsByAccount apats $                          rawledger l       depth = depthFromOpts opts-      (apats,_) = parseAccountDescriptionArgs opts args+      (apats,_) = parsePatternArgs args

@@ -15,24 +15,20 @@ Installation ------------ -Building hledger requires GHC (http://haskell.org/ghc); it is known to-build with GHC 6.8 and up. hledger should work on any platform which GHC-supports.  --Also, installing hledger easily requires the "cabal" command-line tool,-version 0.6.0 and up (http://www.haskell.org/cabal/download.html). (You-can manually download and install each dependency mentioned in-hledger.cabal from hackage.org, but installing cabal is much quicker.)+Platform binaries are not yet being published; you could try asking for+one on the #ledger channel.  -Here's how to download and install the latest hledger release::+Building hledger requires GHC 6.8 or later (http://haskell.org/ghc).+hledger should work on any platform which GHC supports.+Also, installing hledger's dependencies easily requires cabal-install+version 0.6 or later (http://www.haskell.org/cabal/download.html).+Once these tools are installed on your system, do::   cabal update- cabal install hledger (add -f happs to include the web ui)--Or, to get the latest development code::-- darcs get http://joyful.com/repos/hledger+ cabal install hledger [-fvty] [-fhapps] +The vty and happs flags are optional; they enable hledger's "ui" and "web"+commands respectively. vty is not available on the windows platform.  Usage -----@@ -41,47 +37,50 @@ different file, specify it with the LEDGER environment variable or -f option (which may be - for standard input). Basic usage is:: - hledger [OPTIONS] COMMAND [PATTERNS]+ hledger [OPTIONS] [COMMAND [PATTERNS]] -where COMMAND is one of balance, print, register, ui, web, test; and-PATTERNS are zero or more regular expressions used to narrow the results.-Here are some commands to try::+COMMAND is one of balance, print, register, ui, web, test (defaulting to+balance). PATTERNS are zero or more regular expressions used to narrow the+results.  Here are some commands to try:: - hledger --help  export LEDGER=sample.ledger- hledger balance- hledger bal --depth 1- hledger register- hledger reg income- hledger reg desc:shop- hledger ui- hledger web # if you installed with -f happs+ hledger --help                        # show usage & options+ hledger balance                       # all accounts with aggregated balances+ hledger bal --depth 1                 # only top-level accounts+ hledger register                      # transaction register+ hledger reg income                    # transactions to/from an income account+ hledger reg checking                  # checking transactions+ hledger reg desc:shop                 # transactions with shop in the description+ hledger histogram                     # transactions per day, or other interval+ hledger ui                            # interactive ui, if installed with -fvty+ hledger web                           # web ui, installed with -fhapps+ echo >new; hledger -f new add         # input transactions from the command line   Time reporting --------------+ hledger will also read timeclock.el-format timelog entries.  As a-convenience, if you invoke the hledger executable via a link or copy named-"hours", it looks for your timelog file (~/.timelog, or the file specified-by $TIMELOG or -f), and parses arguments slightly differently::+convenience, if you invoke hledger via a link or copy named "hours", it+uses your timelog file (~/.timelog or $TIMELOG) by default.:: - hours [OPTIONS] [PERIOD [COMMAND [PATTERNS]]]+ hours [OPTIONS] [COMMAND [PATTERNS]] -where PERIOD is a ledger-style period expression, defaulting to "today",-and COMMAND is one of the commands above. Timelog entries look like this::+Timelog entries look like this::   i 2009/03/31 22:21:45 some:project  o 2009/04/01 02:00:34 -The clock-in project is treated as an account. Here are some time queries to try::+The clockin description is treated as an account name. Here are some+queries to try:: - export TIMELOG=/my/timelog            # if it's not ~/.timelog- hours                                 # today's balances- hours today                           # the same- hours 'this week'                     # so far this week- hours lastmonth                       # the space is optional- hours 'from 1/15' register            # sessions since last january 15- hours 'monthly in 2009' reg --depth 1 # monthly time summary, top level only+ ln -s `which hledger` ~/bin/hours      # add the "hours" symlink in your path+ export TIMELOG=sample.timelog+ hours                                  # time logged today, if any+ hours -p 'last month'                     # last month+ hours -p thisyear                         # the space is optional+ hours -p 'from 1/15' register proj        # project sessions since last jan 15+ hours -p 'weekly this year' reg --depth 1 # weekly time summary  Features --------@@ -128,6 +127,9 @@ display expressions consisting of a simple date predicate. Also the following new commands are supported:: +   histogram              show a (textual) barchart of transaction counts+   add                    input transactions from the command line+   convert                convert CSV bank data to ledger journal format    ui                     a simple interactive text ui (only on unix platforms)    web                    a simple web ui    test                   run self-tests@@ -136,7 +138,7 @@ .............................  ledger features not currently supported include: modifier and periodic-entries, and options such as these::+entries, and the following options and commands::     Basic options:    -o, --output FILE      write output to FILE@@ -209,3 +211,6 @@ * hledger always shows timelog balances in hours * hledger splits multi-day timelog sessions at midnight * hledger register report always sorts transactions by date+* hledger doesn't show description comments as part of the description+* hledger print puts a blank line after the entry, not before it+* hledger doesn't print the trailing spaces after amount-elided postings

@@ -6,10 +6,12 @@  module RegisterCommand where+import Prelude hiding (putStr) import qualified Data.Map as Map import Data.Map ((!)) import Ledger import Options+import System.IO.UTF8   -- | Print a register report.@@ -33,18 +35,17 @@     | otherwise = showtxns summaryts nulltxn startbal     where       interval = intervalFromOpts opts-      ts = sort $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l-           where sort = sortBy (\a b -> compare (date a) (date b))-      filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ account t) <= depth)+      ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l+      filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)                   | otherwise = id       filterempties           | Empty `elem` opts = id-          | otherwise = filter (not . isZeroMixedAmount . amount)+          | otherwise = filter (not . isZeroMixedAmount . tamount)       (precedingts, ts') = break (matchdisplayopt dopt) ts       (displayedts, _) = span (matchdisplayopt dopt) ts'       startbal = sumTransactions precedingts-      matchapats t = matchpats apats $ account t-      apats = fst $ parseAccountDescriptionArgs opts args+      matchapats t = matchpats apats $ taccount t+      (apats,_) = parsePatternArgs args       matchdisplayopt Nothing t = True       matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t       dopt = displayFromOpts opts@@ -62,7 +63,7 @@ -- As usual with date spans the end date is exclusive, but for display -- purposes we show the previous day as end date, like ledger. -- --- A unique entryno value is provided so that the new transactions will be+-- A unique tnum value is provided so that the new transactions will be -- grouped as one entry. --  -- When a depth argument is present, transactions to accounts of greater@@ -71,54 +72,47 @@ -- The showempty flag forces the display of a zero-transaction span -- and also zero-transaction accounts within the span. summariseTransactionsInDateSpan :: DateSpan -> Int -> Int -> Bool -> [Transaction] -> [Transaction]-summariseTransactionsInDateSpan (DateSpan b e) entryno depth showempty ts+summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts     | null ts && showempty = [txn]     | null ts = []     | otherwise = summaryts'     where-      txn = nulltxn{entryno=entryno, date=b', description="- "++(showDate $ addDays (-1) e')}-      b' = fromMaybe (date $ head ts) b-      e' = fromMaybe (date $ last ts) e+      txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++(showDate $ addDays (-1) e')}+      b' = fromMaybe (tdate $ head ts) b+      e' = fromMaybe (tdate $ last ts) e       summaryts'           | showempty = summaryts-          | otherwise = filter (not . isZeroMixedAmount . amount) summaryts-      txnanames = sort $ nub $ map account ts+          | otherwise = filter (not . isZeroMixedAmount . tamount) summaryts+      txnanames = sort $ nub $ map taccount ts       -- aggregate balances by account, like cacheLedger, then do depth-clipping       (_,_,exclbalof,inclbalof) = groupTransactions ts       clippedanames = clipAccountNames depth txnanames       isclipped a = accountNameLevel a >= depth       balancetoshowfor a =           (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)-      summaryts = [txn{account=a,amount=balancetoshowfor a} | a <- clippedanames]+      summaryts = [txn{taccount=a,tamount=balancetoshowfor a} | a <- clippedanames]  clipAccountNames :: Int -> [AccountName] -> [AccountName] clipAccountNames d as = nub $ map (clip d) as      where clip d = accountNameFromComponents . take d . accountNameComponents --- | Does the given transaction fall within the given date span ?-isTransactionInDateSpan :: DateSpan -> Transaction -> Bool-isTransactionInDateSpan (DateSpan Nothing Nothing)   _ = True-isTransactionInDateSpan (DateSpan Nothing (Just e))  (Transaction{date=d}) = d<e-isTransactionInDateSpan (DateSpan (Just b) Nothing)  (Transaction{date=d}) = d>=b-isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{date=d}) = d>=b && d<e- -- | Show transactions one per line, with each date/description appearing -- only once, and a running balance. showtxns [] _ _ = ""-showtxns (t@Transaction{amount=a}:ts) tprev bal = this ++ showtxns ts t bal'+showtxns (t@Transaction{tamount=a}:ts) tprev bal = this ++ showtxns ts t bal'     where       this = showtxn (t `issame` tprev) t bal'-      issame t1 t2 = entryno t1 == entryno t2-      bal' = bal + amount t+      issame t1 t2 = tnum t1 == tnum t2+      bal' = bal + tamount t  -- | Show one transaction line and balance with or without the entry details. showtxn :: Bool -> Transaction -> MixedAmount -> String-showtxn omitdesc t b = concatBottomPadded [entrydesc ++ txn ++ " ", bal] ++ "\n"+showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"     where       entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc       date = showDate $ da       desc = printf "%-20s" $ elideRight 20 de :: String-      txn = showRawTransaction $ RawTransaction s a amt "" tt+      p = showPosting $ Posting s a amt "" tt       bal = padleft 12 (showMixedAmountOrZero b)-      Transaction{status=s,date=da,description=de,account=a,amount=amt,ttype=tt} = t+      Transaction{tstatus=s,tdate=da,tdescription=de,taccount=a,tamount=amt,ttype=tt} = t 

@@ -18,8 +18,8 @@  - not platform independent -All doctests are included below. Some of these may also appear in other-modules as examples within the api docs.+Here are the hledger doctests (some may reappear in other modules as+examples):  Run a few with c++ ledger first: @@ -80,7 +80,67 @@                  $-2  income                   $1  liabilities @+-}+{-+@+$ printf "2009/1/1 a\n  b  1.1\n  c  -1\n" | runhaskell hledger.hs -f- reg 2>&1 ; true+hledger.hs: could not balance this transaction, amounts do not add up to zero:+2009/01/01 a+    b                                            1.1+    c                                             -1 ++@++Unicode input/output tests++-- layout of the balance command with unicode names+@+$ printf "2009-01-01 проверка\n  τράπεζα  10 руб\n  नकद\n" | hledger -f - bal+              10 руб  τράπεζα+             -10 руб  नकद+@++-- layout of the register command with unicode names+@+$ printf "2009-01-01 проверка\n  τράπεζα  10 руб\n  नकद\n" | hledger -f - reg+2009/01/01 проверка             τράπεζα                      10 руб       10 руб+                                नकद                         -10 руб            0+@++-- layout of the print command with unicode names+@+$ printf "2009-01-01 проверка\n счёт:первый  1\n счёт:второй\n" | hledger -f - print+2009/01/01 проверка+    счёт:первый                                    1+    счёт:второй++@++-- search for unicode account names+@+$ printf "2009-01-01 проверка\n  τράπεζα  10 руб\n  नकद\n" | hledger -f - reg τράπ+2009/01/01 проверка             τράπεζα                      10 руб       10 руб+@++-- search for unicode descriptions (should choose only the first entry)+@+$ printf "2009-01-01 аура (cyrillic letters)\n  bank  10\n  cash\n2010-01-01 aypa (roman letters)\n  bank  20\n  cash\n" | hledger -f - reg desc:аура+2009/01/01 аура (cyrillic let.. bank                             10           10+                                cash                            -10            0+@++-- error message with unicode in ledger+-- not implemented yet+--@+$ printf "2009-01-01 broken entry\n  дебит  1\n  кредит  -2\n" | hledger -f - 2>&1 ; true+hledger: could not balance this transaction, amounts do not add up to zero:+2009/01/01 broken entry+    дебит                                          1+    кредит                                        -2+++--@ -} -- other test tools: -- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/test-framework@@ -129,20 +189,23 @@  -- | Simple way to assert something is some expected value, with no label. is :: (Eq a, Show a) => a -> a -> Assertion-a `is` e = assertEqual "" a e+a `is` e = assertEqual "" e a  -- | Assert a parse result is some expected value, or print a parse error. parseis :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion parse `parseis` expected = either printParseError (`is` expected) parse +parseWithCtx :: GenParser Char LedgerFileCtx a -> String -> Either ParseError a+parseWithCtx p ts = runParser p emptyCtx "" ts+ ------------------------------------------------------------------------------ -- | Tests for any function or topic. Mostly ordered by test name. tests :: [Test] tests = [     "account directive" ~: -   let sameParse str1 str2 = do l1 <- rawledgerfromstring str1-                                l2 <- rawledgerfromstring str2+   let sameParse str1 str2 = do l1 <- rawLedgerFromString str1+                                l2 <- rawLedgerFromString str2                                 l1 `is` l2    in TestList    [@@ -320,7 +383,7 @@     ]     ,"balance report with cost basis" ~: do-      rl <- rawledgerfromstring $ unlines+      rl <- rawLedgerFromString $ unlines              [""              ,"2008/1/1 test           "              ,"  a:b          10h @ $50"@@ -328,7 +391,7 @@              ,""              ]       let l = cacheLedger [] $ -              filterRawLedger (DateSpan Nothing Nothing) [] False False $ +              filterRawLedger (DateSpan Nothing Nothing) [] Nothing False $                canonicaliseAmounts True rl -- enable cost basis adjustment                   showBalanceReport [] [] l `is`         unlines@@ -337,7 +400,7 @@         ]     ,"balance report elides zero-balance root account(s)" ~: do-      l <- ledgerfromstringwithopts [] [] sampletime+      l <- ledgerFromStringWithOpts [] [] sampletime              (unlines               ["2008/1/1 one"               ,"  test:a  1"@@ -351,28 +414,28 @@     ] -  ,"balanceEntry" ~: do+  ,"balanceLedgerTransaction" ~: do      assertBool "detect unbalanced entry, sign error"-                    (isLeft $ balanceEntry-                           (Entry (parsedate "2007/01/28") False "" "test" ""-                            [RawTransaction False "a" (Mixed [dollars 1]) "" RegularTransaction, -                             RawTransaction False "b" (Mixed [dollars 1]) "" RegularTransaction+                    (isLeft $ balanceLedgerTransaction+                           (LedgerTransaction (parsedate "2007/01/28") False "" "test" ""+                            [Posting False "a" (Mixed [dollars 1]) "" RegularPosting, +                             Posting False "b" (Mixed [dollars 1]) "" RegularPosting                             ] ""))      assertBool "detect unbalanced entry, multiple missing amounts"-                    (isLeft $ balanceEntry-                           (Entry (parsedate "2007/01/28") False "" "test" ""-                            [RawTransaction False "a" missingamt "" RegularTransaction, -                             RawTransaction False "b" missingamt "" RegularTransaction+                    (isLeft $ balanceLedgerTransaction+                           (LedgerTransaction (parsedate "2007/01/28") False "" "test" ""+                            [Posting False "a" missingamt "" RegularPosting, +                             Posting False "b" missingamt "" RegularPosting                             ] ""))-     let e = balanceEntry (Entry (parsedate "2007/01/28") False "" "test" ""-                           [RawTransaction False "a" (Mixed [dollars 1]) "" RegularTransaction, -                            RawTransaction False "b" missingamt "" RegularTransaction+     let e = balanceLedgerTransaction (LedgerTransaction (parsedate "2007/01/28") False "" "test" ""+                           [Posting False "a" (Mixed [dollars 1]) "" RegularPosting, +                            Posting False "b" missingamt "" RegularPosting                            ] "")      assertBool "one missing amount should be ok" (isRight e)      assertEqual "balancing amount is added"                       (Mixed [dollars (-1)])                      (case e of-                        Right e' -> (tamount $ last $ etransactions e')+                        Right e' -> (pamount $ last $ ltpostings e')                         Left _ -> error "should not happen")    ,"cacheLedger" ~: do@@ -397,11 +460,11 @@      let now = utcToLocalTime tz now'          nowstr = showtime now          yesterday = prevday today-         clockin t a = TimeLogEntry 'i' t a-         clockout t = TimeLogEntry 'o' t ""+         clockin t a = TimeLogEntry In t a+         clockout t = TimeLogEntry Out t ""          mktime d s = LocalTime d $ fromMaybe midnight $ parseTime defaultTimeLocale "%H:%M:%S" s          showtime t = formatTime defaultTimeLocale "%H:%M" t-         assertEntriesGiveStrings name es ss = assertEqual name ss (map edescription $ entriesFromTimeLogEntries now es)+         assertEntriesGiveStrings name es ss = assertEqual name ss (map ltdescription $ entriesFromTimeLogEntries now es)       assertEntriesGiveStrings "started yesterday, split session at midnight"                                   [clockin (mktime yesterday "23:00:00") ""]@@ -427,9 +490,11 @@     [] `gives` NoInterval     [WeeklyOpt] `gives` Weekly     [MonthlyOpt] `gives` Monthly+    [QuarterlyOpt] `gives` Quarterly     [YearlyOpt] `gives` Yearly     [Period "weekly"] `gives` Weekly     [Period "monthly"] `gives` Monthly+    [Period "quarterly"] `gives` Quarterly     [WeeklyOpt, Period "yearly"] `gives` Yearly    ,"isAccountNamePrefixOf" ~: do@@ -438,6 +503,52 @@     "assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True     "my assets" `isAccountNamePrefixOf` "assets:bank" `is` False +  ,"isLedgerTransactionBalanced" ~: do+     assertBool "detect balanced"+        (isLedgerTransactionBalanced+        (LedgerTransaction (parsedate "2009/01/01") False "" "a" ""+         [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting+         ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting+         ] ""))+     assertBool "detect unbalanced"+        (not $ isLedgerTransactionBalanced+        (LedgerTransaction (parsedate "2009/01/01") False "" "a" ""+         [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting+         ,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting+         ] ""))+     assertBool "detect unbalanced, one posting"+        (not $ isLedgerTransactionBalanced+        (LedgerTransaction (parsedate "2009/01/01") False "" "a" ""+         [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting+         ] ""))+     assertBool "one zero posting is considered balanced for now"+        (isLedgerTransactionBalanced+        (LedgerTransaction (parsedate "2009/01/01") False "" "a" ""+         [Posting False "b" (Mixed [dollars 0]) "" RegularPosting+         ] ""))+     assertBool "virtual postings don't need to balance"+        (isLedgerTransactionBalanced+        (LedgerTransaction (parsedate "2009/01/01") False "" "a" ""+         [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting+         ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting+         ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting+         ] ""))+     assertBool "balanced virtual postings need to balance among themselves"+        (not $ isLedgerTransactionBalanced+        (LedgerTransaction (parsedate "2009/01/01") False "" "a" ""+         [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting+         ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting+         ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting+         ] ""))+     assertBool "balanced virtual postings need to balance among themselves (2)"+        (isLedgerTransactionBalanced+        (LedgerTransaction (parsedate "2009/01/01") False "" "a" ""+         [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting+         ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting+         ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting+         ,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting+         ] ""))+   ,"isSubAccountNameOf" ~: do     "assets" `isSubAccountNameOf` "assets" `is` False     "assets:bank" `isSubAccountNameOf` "assets" `is` True@@ -445,19 +556,32 @@     "assets:bank" `isSubAccountNameOf` "my assets" `is` False    ,"default year" ~: do-    rl <- rawledgerfromstring defaultyear_ledger_str-    (edate $ head $ entries rl) `is` fromGregorian 2009 1 1+    rl <- rawLedgerFromString defaultyear_ledger_str+    (ltdate $ head $ ledger_txns rl) `is` fromGregorian 2009 1 1     return () -  ,"ledgerEntry" ~: do-    parseWithCtx ledgerEntry entry1_str `parseis` entry1+  ,"ledgerFile" ~: do+    let now = getCurrentLocalTime+    assertBool "ledgerFile should parse an empty file" $ (isRight $ parseWithCtx ledgerFile "")+    r <- rawLedgerFromString "" -- don't know how to get it from ledgerFile+    assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ ledger_txns r    ,"ledgerHistoricalPrice" ~: do     parseWithCtx ledgerHistoricalPrice price1_str `parseis` price1 -  ,"ledgertransaction" ~: do-    parseWithCtx ledgertransaction rawtransaction1_str `parseis` rawtransaction1+  ,"ledgerTransaction" ~: do+    parseWithCtx ledgerTransaction entry1_str `parseis` entry1+    assertBool "ledgerTransaction should not parse just a date"+                   $ isLeft $ parseWithCtx ledgerTransaction "2009/1/1\n"+    assertBool "ledgerTransaction should require some postings"+                   $ isLeft $ parseWithCtx ledgerTransaction "2009/1/1 a\n"+    let t = parseWithCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"+    assertBool "ledgerTransaction should not include a comment in the description"+                   $ either (const False) ((== "a") . ltdescription) t +  ,"ledgerposting" ~: do+    parseWithCtx ledgerposting rawposting1_str `parseis` rawposting1+   ,"parsedate" ~: do     parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" sampledate     parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" sampledate@@ -478,18 +602,18 @@    do      let args = ["expenses"]     l <- sampleledgerwithopts [] args-    showEntries [] args l `is` unlines +    showLedgerTransactions [] args l `is` unlines       ["2008/06/03 * eat & shop"      ,"    expenses:food                                 $1"      ,"    expenses:supplies                             $1"-     ,"    assets:cash                                  $-2"+     ,"    assets:cash"      ,""      ]    , "print report with depth arg" ~:    do      l <- sampleledger-    showEntries [Depth "2"] [] l `is` unlines+    showLedgerTransactions [Depth "2"] [] l `is` unlines       ["2008/01/01 income"       ,"    income:salary                                $-1"       ,""@@ -499,7 +623,7 @@       ,"2008/06/03 * eat & shop"       ,"    expenses:food                                 $1"       ,"    expenses:supplies                             $1"-      ,"    assets:cash                                  $-2"+      ,"    assets:cash"       ,""       ,"2008/12/31 * pay off"       ,"    liabilities:debts                             $1"@@ -537,9 +661,32 @@      ,"                                assets:bank:checking            $-1            0"      ] +  ,"register report with cleared arg" ~:+   do +    l <- ledgerFromStringWithOpts [Cleared] [] sampletime sample_ledger_str+    showRegisterReport [Cleared] [] l `is` unlines+     ["2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"register report with uncleared arg" ~:+   do +    l <- ledgerFromStringWithOpts [UnCleared] [] sampletime sample_ledger_str+    showRegisterReport [UnCleared] [] l `is` unlines+     ["2008/01/01 income               assets:bank:checking             $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank:saving               $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]+   ,"register report sorts by date" ~:    do -    l <- ledgerfromstringwithopts [] [] sampletime $ unlines+    l <- ledgerFromStringWithOpts [] [] sampletime $ unlines         ["2008/02/02 a"         ,"  b  1"         ,"  c"@@ -586,6 +733,7 @@     "2007" `gives` []     "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]     "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]+    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]     showRegisterReport [Period "yearly"] [] l `is` unlines      ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"      ,"                                assets:cash                     $-2          $-1"@@ -616,6 +764,67 @@    ,"show hours" ~: show (hours 1) ~?= "1.0h" +  ,"showLedgerTransaction" ~: do+     assertEqual "show a balanced transaction, eliding last amount"+       (unlines+        ["2007/01/28 coopportunity"+        ,"    expenses:food:groceries                   $47.18"+        ,"    assets:checking"+        ,""+        ])+       (showLedgerTransaction+        (LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""+         [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting+         ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting+         ] ""))+     -- document some cases that arise in debug/testing:+     assertEqual "show an unbalanced transaction, should not elide"+       (unlines+        ["2007/01/28 coopportunity"+        ,"    expenses:food:groceries                   $47.18"+        ,"    assets:checking                          $-47.19"+        ,""+        ])+       (showLedgerTransaction+        (LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""+         [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting+         ,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting+         ] ""))+     assertEqual "show an unbalanced transaction with one posting, should not elide"+       (unlines+        ["2007/01/28 coopportunity"+        ,"    expenses:food:groceries                   $47.18"+        ,""+        ])+       (showLedgerTransaction+        (LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""+         [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting+         ] ""))+     assertEqual "show a transaction with one posting and a missing amount"+       (unlines+        ["2007/01/28 coopportunity"+        ,"    expenses:food:groceries                         "+        ,""+        ])+       (showLedgerTransaction+        (LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""+         [Posting False "expenses:food:groceries" missingamt "" RegularPosting+         ] ""))++  ,"unicode in balance layout" ~: do+    l <- ledgerFromStringWithOpts [] [] sampletime+      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"+    showBalanceReport [] [] l `is` unlines+      ["                -100  актив:наличные"+      ,"                 100  расходы:покупки"]++  ,"unicode in register layout" ~: do+    l <- ledgerFromStringWithOpts [] [] sampletime+      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"+    showRegisterReport [] [] l `is` unlines+      ["2009/01/01 медвежья шкура       расходы:покупки                 100          100"+      ,"                                актив:наличные                 -100            0"]+   ,"smart dates" ~: do     let str `gives` datestr = fixSmartDateStr (parsedate "2008/11/26") str `is` datestr     "1999-12-02"   `gives` "1999/12/02"@@ -671,49 +880,46 @@   ,"subAccounts" ~: do     l <- sampleledger     let a = ledgerAccount l "assets"-    (map aname $ subAccounts l a) `is` ["assets:bank","assets:cash"]+    (map aname $ ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]    ,"summariseTransactionsInDateSpan" ~: do-    let (b,e,entryno,depth,showempty,ts) `gives` summaryts = -            summariseTransactionsInDateSpan (mkdatespan b e) entryno depth showempty ts `is` summaryts+    let (b,e,tnum,depth,showempty,ts) `gives` summaryts = +            summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is` summaryts     let ts =             [-             nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]}-            ,nulltxn{description="desc",account="expenses:food:dining",   amount=Mixed [dollars 2]}-            ,nulltxn{description="desc",account="expenses:food",          amount=Mixed [dollars 4]}-            ,nulltxn{description="desc",account="expenses:food:dining",   amount=Mixed [dollars 8]}+             nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]}+            ,nulltxn{tdescription="desc",taccount="expenses:food:dining",   tamount=Mixed [dollars 2]}+            ,nulltxn{tdescription="desc",taccount="expenses:food",          tamount=Mixed [dollars 4]}+            ,nulltxn{tdescription="desc",taccount="expenses:food:dining",   tamount=Mixed [dollars 8]}             ]     ("2008/01/01","2009/01/01",0,9999,False,[]) `gives`       []     ("2008/01/01","2009/01/01",0,9999,True,[]) `gives`       [-      nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31"}+      nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31"}      ]     ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`       [-      nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food",          amount=Mixed [dollars 4]}-     ,nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food:dining",   amount=Mixed [dollars 10]}-     ,nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food:groceries",amount=Mixed [dollars 1]}+      nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food",          tamount=Mixed [dollars 4]}+     ,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:dining",   tamount=Mixed [dollars 10]}+     ,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]}      ]     ("2008/01/01","2009/01/01",0,2,False,ts) `gives`       [-      nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food",amount=Mixed [dollars 15]}+      nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food",tamount=Mixed [dollars 15]}      ]     ("2008/01/01","2009/01/01",0,1,False,ts) `gives`       [-      nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses",amount=Mixed [dollars 15]}+      nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses",tamount=Mixed [dollars 15]}      ]     ("2008/01/01","2009/01/01",0,0,False,ts) `gives`       [-      nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="",amount=Mixed [dollars 15]}+      nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="",tamount=Mixed [dollars 15]}      ] -  ,"timelog" ~: do-    parseWithCtx timelog timelog1_str `parseis` timelog1--  ,"transactionamount" ~: do-    parseWithCtx transactionamount " $47.18" `parseis` Mixed [dollars 47.18]-    parseWithCtx transactionamount " $1." `parseis` +  ,"postingamount" ~: do+    parseWithCtx postingamount " $47.18" `parseis` Mixed [dollars 47.18]+    parseWithCtx postingamount " $1." `parseis`       Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0}) 1 Nothing]    ]@@ -724,8 +930,8 @@  sampledate = parsedate "2008/11/26" sampletime = LocalTime sampledate midday-sampleledger = ledgerfromstringwithopts [] [] sampletime sample_ledger_str-sampleledgerwithopts opts args = ledgerfromstringwithopts opts args sampletime sample_ledger_str+sampleledger = ledgerFromStringWithOpts [] [] sampletime sample_ledger_str+sampleledgerwithopts opts args = ledgerFromStringWithOpts opts args sampletime sample_ledger_str  sample_ledger_str = unlines  ["; A sample ledger file."@@ -780,28 +986,28 @@  write_sample_ledger = writeFile "sample.ledger" sample_ledger_str -rawtransaction1_str  = "  expenses:food:dining  $10.00\n"+rawposting1_str  = "  expenses:food:dining  $10.00\n" -rawtransaction1 = RawTransaction False "expenses:food:dining" (Mixed [dollars 10]) "" RegularTransaction+rawposting1 = Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting  entry1_str = unlines  ["2007/01/28 coopportunity"- ,"  expenses:food:groceries                 $47.18"- ,"  assets:checking"+ ,"    expenses:food:groceries                   $47.18"+ ,"    assets:checking"  ,""  ]  entry1 =-    (Entry (parsedate "2007/01/28") False "" "coopportunity" ""-     [RawTransaction False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularTransaction, -      RawTransaction False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularTransaction] "")+    (LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""+     [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting, +      Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "")   entry2_str = unlines  ["2007/01/27 * joes diner"- ,"  expenses:food:dining                    $10.00"- ,"  expenses:gifts                          $10.00"- ,"  assets:checking                        $-20.00"+ ,"    expenses:food:dining                      $10.00"+ ,"    expenses:gifts                            $10.00"+ ,"    assets:checking                          $-20.00"  ,""  ] @@ -940,159 +1146,160 @@           []            []            [-           Entry {-             edate= parsedate "2007/01/01", -             estatus=False, -             ecode="*", -             edescription="opening balance", -             ecomment="",-             etransactions=[-              RawTransaction {-                tstatus=False,-                taccount="assets:cash", -                tamount=(Mixed [dollars 4.82]),-                tcomment="",-                rttype=RegularTransaction+           LedgerTransaction {+             ltdate= parsedate "2007/01/01", +             ltstatus=False, +             ltcode="*", +             ltdescription="opening balance", +             ltcomment="",+             ltpostings=[+              Posting {+                pstatus=False,+                paccount="assets:cash", +                pamount=(Mixed [dollars 4.82]),+                pcomment="",+                ptype=RegularPosting               },-              RawTransaction {-                tstatus=False,-                taccount="equity:opening balances", -                tamount=(Mixed [dollars (-4.82)]),-                tcomment="",-                rttype=RegularTransaction+              Posting {+                pstatus=False,+                paccount="equity:opening balances", +                pamount=(Mixed [dollars (-4.82)]),+                pcomment="",+                ptype=RegularPosting               }              ],-             epreceding_comment_lines=""+             ltpreceding_comment_lines=""            }           ,-           Entry {-             edate= parsedate "2007/02/01", -             estatus=False, -             ecode="*", -             edescription="ayres suites", -             ecomment="",-             etransactions=[-              RawTransaction {-                tstatus=False,-                taccount="expenses:vacation", -                tamount=(Mixed [dollars 179.92]),-                tcomment="",-                rttype=RegularTransaction+           LedgerTransaction {+             ltdate= parsedate "2007/02/01", +             ltstatus=False, +             ltcode="*", +             ltdescription="ayres suites", +             ltcomment="",+             ltpostings=[+              Posting {+                pstatus=False,+                paccount="expenses:vacation", +                pamount=(Mixed [dollars 179.92]),+                pcomment="",+                ptype=RegularPosting               },-              RawTransaction {-                tstatus=False,-                taccount="assets:checking", -                tamount=(Mixed [dollars (-179.92)]),-                tcomment="",-                rttype=RegularTransaction+              Posting {+                pstatus=False,+                paccount="assets:checking", +                pamount=(Mixed [dollars (-179.92)]),+                pcomment="",+                ptype=RegularPosting               }              ],-             epreceding_comment_lines=""+             ltpreceding_comment_lines=""            }           ,-           Entry {-             edate=parsedate "2007/01/02", -             estatus=False, -             ecode="*", -             edescription="auto transfer to savings", -             ecomment="",-             etransactions=[-              RawTransaction {-                tstatus=False,-                taccount="assets:saving", -                tamount=(Mixed [dollars 200]),-                tcomment="",-                rttype=RegularTransaction+           LedgerTransaction {+             ltdate=parsedate "2007/01/02", +             ltstatus=False, +             ltcode="*", +             ltdescription="auto transfer to savings", +             ltcomment="",+             ltpostings=[+              Posting {+                pstatus=False,+                paccount="assets:saving", +                pamount=(Mixed [dollars 200]),+                pcomment="",+                ptype=RegularPosting               },-              RawTransaction {-                tstatus=False,-                taccount="assets:checking", -                tamount=(Mixed [dollars (-200)]),-                tcomment="",-                rttype=RegularTransaction+              Posting {+                pstatus=False,+                paccount="assets:checking", +                pamount=(Mixed [dollars (-200)]),+                pcomment="",+                ptype=RegularPosting               }              ],-             epreceding_comment_lines=""+             ltpreceding_comment_lines=""            }           ,-           Entry {-             edate=parsedate "2007/01/03", -             estatus=False, -             ecode="*", -             edescription="poquito mas", -             ecomment="",-             etransactions=[-              RawTransaction {-                tstatus=False,-                taccount="expenses:food:dining", -                tamount=(Mixed [dollars 4.82]),-                tcomment="",-                rttype=RegularTransaction+           LedgerTransaction {+             ltdate=parsedate "2007/01/03", +             ltstatus=False, +             ltcode="*", +             ltdescription="poquito mas", +             ltcomment="",+             ltpostings=[+              Posting {+                pstatus=False,+                paccount="expenses:food:dining", +                pamount=(Mixed [dollars 4.82]),+                pcomment="",+                ptype=RegularPosting               },-              RawTransaction {-                tstatus=False,-                taccount="assets:cash", -                tamount=(Mixed [dollars (-4.82)]),-                tcomment="",-                rttype=RegularTransaction+              Posting {+                pstatus=False,+                paccount="assets:cash", +                pamount=(Mixed [dollars (-4.82)]),+                pcomment="",+                ptype=RegularPosting               }              ],-             epreceding_comment_lines=""+             ltpreceding_comment_lines=""            }           ,-           Entry {-             edate=parsedate "2007/01/03", -             estatus=False, -             ecode="*", -             edescription="verizon", -             ecomment="",-             etransactions=[-              RawTransaction {-                tstatus=False,-                taccount="expenses:phone", -                tamount=(Mixed [dollars 95.11]),-                tcomment="",-                rttype=RegularTransaction+           LedgerTransaction {+             ltdate=parsedate "2007/01/03", +             ltstatus=False, +             ltcode="*", +             ltdescription="verizon", +             ltcomment="",+             ltpostings=[+              Posting {+                pstatus=False,+                paccount="expenses:phone", +                pamount=(Mixed [dollars 95.11]),+                pcomment="",+                ptype=RegularPosting               },-              RawTransaction {-                tstatus=False,-                taccount="assets:checking", -                tamount=(Mixed [dollars (-95.11)]),-                tcomment="",-                rttype=RegularTransaction+              Posting {+                pstatus=False,+                paccount="assets:checking", +                pamount=(Mixed [dollars (-95.11)]),+                pcomment="",+                ptype=RegularPosting               }              ],-             epreceding_comment_lines=""+             ltpreceding_comment_lines=""            }           ,-           Entry {-             edate=parsedate "2007/01/03", -             estatus=False, -             ecode="*", -             edescription="discover", -             ecomment="",-             etransactions=[-              RawTransaction {-                tstatus=False,-                taccount="liabilities:credit cards:discover", -                tamount=(Mixed [dollars 80]),-                tcomment="",-                rttype=RegularTransaction+           LedgerTransaction {+             ltdate=parsedate "2007/01/03", +             ltstatus=False, +             ltcode="*", +             ltdescription="discover", +             ltcomment="",+             ltpostings=[+              Posting {+                pstatus=False,+                paccount="liabilities:credit cards:discover", +                pamount=(Mixed [dollars 80]),+                pcomment="",+                ptype=RegularPosting               },-              RawTransaction {-                tstatus=False,-                taccount="assets:checking", -                tamount=(Mixed [dollars (-80)]),-                tcomment="",-                rttype=RegularTransaction+              Posting {+                pstatus=False,+                paccount="assets:checking", +                pamount=(Mixed [dollars (-80)]),+                pcomment="",+                ptype=RegularPosting               }              ],-             epreceding_comment_lines=""+             ltpreceding_comment_lines=""            }           ]            []           []           ""+          ""  ledger7 = cacheLedger [] rawledger7  @@ -1104,19 +1311,10 @@  ]  timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n"-timelogentry1 = TimeLogEntry 'i' (parsedatetime "2007/03/11 16:19:00") "hledger"+timelogentry1 = TimeLogEntry In (parsedatetime "2007/03/11 16:19:00") "hledger"  timelogentry2_str  = "o 2007/03/11 16:30:00\n"-timelogentry2 = TimeLogEntry 'o' (parsedatetime "2007/03/11 16:30:00") ""--timelog1_str = concat [-                timelogentry1_str,-                timelogentry2_str-               ]-timelog1 = TimeLog [-            timelogentry1,-            timelogentry2-           ]+timelogentry2 = TimeLogEntry Out (parsedatetime "2007/03/11 16:30:00") ""  price1_str = "P 2004/05/01 XYZ $55\n" price1 = HistoricalPrice (parsedate "2004/05/01") "XYZ" "$" 55@@ -1125,13 +1323,15 @@ a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}] a3 = Mixed $ (amounts a1) ++ (amounts a2) +rawLedgerWithAmounts :: [String] -> RawLedger rawLedgerWithAmounts as =          RawLedger          []          [] -        [nullentry{edescription=a,etransactions=[nullrawtxn{tamount=parse a}]} | a <- as]+        [nullledgertxn{ltdescription=a,ltpostings=[nullrawposting{pamount=parse a}]} | a <- as]         []         []         ""-    where parse = fromparse . parseWithCtx transactionamount . (" "++)+        ""+    where parse = fromparse . parseWithCtx postingamount . (" "++) 

@@ -44,8 +44,8 @@  -- | The screens available within the user interface. data Screen = BalanceScreen     -- ^ like hledger balance, shows accounts-            | RegisterScreen    -- ^ like hledger register, shows transactions-            | PrintScreen       -- ^ like hledger print, shows entries+            | RegisterScreen    -- ^ like hledger register, shows transaction-postings+            | PrintScreen       -- ^ like hledger print, shows ledger transactions             | LedgerScreen      -- ^ shows the raw ledger               deriving (Eq,Show) @@ -221,7 +221,7 @@ updateData a@AppState{aopts=opts,aargs=args,aledger=l}     | scr == BalanceScreen  = a{abuf=lines $ showBalanceReport opts [] l, aargs=[]}     | scr == RegisterScreen = a{abuf=lines $ showRegisterReport opts args l}-    | scr == PrintScreen    = a{abuf=lines $ showEntries opts args l}+    | scr == PrintScreen    = a{abuf=lines $ showLedgerTransactions opts args l}     | scr == LedgerScreen   = a{abuf=lines $ rawledgertext l}     where scr = screen a @@ -233,11 +233,11 @@ drilldown :: AppState -> AppState drilldown a     | screen a == BalanceScreen  = enter RegisterScreen a{aargs=[currentAccountName a]}-    | screen a == RegisterScreen = scrollToEntry e $ enter PrintScreen a+    | screen a == RegisterScreen = scrollToLedgerTransaction e $ enter PrintScreen a     | screen a == PrintScreen   = a     -- screen a == PrintScreen   = enter LedgerScreen a     -- screen a == LedgerScreen   = a-    where e = currentEntry a+    where e = currentLedgerTransaction a  -- | Get the account name currently highlighted by the cursor on the -- balance screen. Results undefined while on other screens.@@ -265,10 +265,10 @@  -- | If on the print screen, move the cursor to highlight the specified entry -- (or a reasonable guess). Doesn't work.-scrollToEntry :: Entry -> AppState -> AppState-scrollToEntry e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a+scrollToLedgerTransaction :: LedgerTransaction -> AppState -> AppState+scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a     where-      entryfirstline = head $ lines $ showEntry $ e+      entryfirstline = head $ lines $ showLedgerTransaction $ e       halfph = pageHeight a `div` 2       y = fromMaybe 0 $ findIndex (== entryfirstline) buf       sy = max 0 $ y - halfph@@ -277,11 +277,11 @@ -- | Get the entry containing the transaction currently highlighted by the -- cursor on the register screen (or best guess). Results undefined while -- on other screens. Doesn't work.-currentEntry :: AppState -> Entry-currentEntry a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t+currentLedgerTransaction :: AppState -> LedgerTransaction+currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t     where       t = safehead nulltxn $ filter ismatch $ ledgerTransactions l-      ismatch t = date t == (parsedate $ take 10 datedesc)+      ismatch t = tdate t == (parsedate $ take 10 datedesc)                   && (take 70 $ showtxn False t nullmixedamt) == (datedesc ++ acctamt)       datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above       acctamt = drop 32 $ safehead "" rest@@ -291,8 +291,8 @@  -- | Get the entry which contains the given transaction. -- Will raise an error if there are problems.-entryContainingTransaction :: AppState -> Transaction -> Entry-entryContainingTransaction AppState{aledger=l} t = (entries $ rawledger l) !! entryno t+entryContainingTransaction :: AppState -> Transaction -> LedgerTransaction+entryContainingTransaction AppState{aledger=l} t = (ledger_txns $ rawledger l) !! tnum t  -- renderers 

@@ -1,57 +1,54 @@ {-| -Utilities for top-level modules and/or ghci. See also "Ledger.Utils".+Utilities for top-level modules and ghci. See also "Ledger.IO" and+"Ledger.Utils".  -}  module Utils where import Control.Monad.Error-import qualified Data.Map as Map (lookup) import Data.Time.Clock-import Text.ParserCombinators.Parsec-import System.IO-import Options import Ledger+import Options (Opt,ledgerFilePathFromOpts,optsToIOArgs)+import System.Directory (doesFileExist)+import System.IO+import Text.ParserCombinators.Parsec+import qualified Data.Map as Map (lookup)  --- | Convert a RawLedger to a canonicalised, cached and filtered Ledger--- based on the command-line options/arguments and the current date/time.-prepareLedger ::  [Opt] -> [String] -> LocalTime -> String -> RawLedger -> Ledger-prepareLedger opts args reftime rawtext rl = l{rawledgertext=rawtext}-    where-      l = cacheLedger apats $ filterRawLedger span dpats c r $ canonicaliseAmounts cb rl-      (apats,dpats) = parseAccountDescriptionArgs [] args-      span = dateSpanFromOpts (localDay reftime) opts-      c = Cleared `elem` opts-      r = Real `elem` opts-      cb = CostBasis `elem` opts---- | Get a RawLedger from the given string, or raise an error.--- This uses the current local time as the reference time (for closing--- open timelog entries).-rawledgerfromstring :: String -> IO RawLedger-rawledgerfromstring s = do+-- | Parse the user's specified ledger file and run a hledger command on+-- it, or report a parse error. This function makes the whole thing go.+withLedgerDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()+withLedgerDo opts args cmdname cmd = do+  -- We kludgily read the file before parsing to grab the full text, unless+  -- it's stdin, or it doesn't exist and we are adding. We read it strictly+  -- to let the add command work.+  f <- ledgerFilePathFromOpts opts+  let f' = if f == "-" then "/dev/null" else f+  fileexists <- doesFileExist f+  let creating = not fileexists && cmdname == "add"+  rawtext <-  if creating then return "" else strictReadFile f'   t <- getCurrentLocalTime-  liftM (either error id) $ runErrorT $ parseLedger t "(string)" s+  let go = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f})+  case creating of+    True -> return rawLedgerEmpty >>= go+    False -> return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) go  -- | Get a Ledger from the given string and options, or raise an error.-ledgerfromstringwithopts :: [Opt] -> [String] -> LocalTime -> String -> IO Ledger-ledgerfromstringwithopts opts args reftime s =-    liftM (prepareLedger opts args reftime s) $ rawledgerfromstring s+ledgerFromStringWithOpts :: [Opt] -> [String] -> LocalTime -> String -> IO Ledger+ledgerFromStringWithOpts opts args reftime s =+    liftM (filterAndCacheLedgerWithOpts opts args reftime s) $ rawLedgerFromString s --- | Get a Ledger from the given file path and options, or raise an error.-ledgerfromfilewithopts :: [Opt] -> [String] -> FilePath -> IO Ledger-ledgerfromfilewithopts opts args f = do-  s <- readFile f -  rl <- rawledgerfromstring s-  reftime <- getCurrentLocalTime-  return $ prepareLedger opts args reftime s rl+-- | Read a Ledger from the given file, filtering according to the+-- options, or give an error.+readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger+readLedgerWithOpts opts args f = do+  t <- getCurrentLocalTime+  readLedgerWithIOArgs (optsToIOArgs opts args t) f            --- | Get a Ledger from your default ledger file, or raise an error.--- Assumes no options.-myledger :: IO Ledger-myledger = ledgerFilePathFromOpts [] >>= ledgerfromfilewithopts [] []+-- | Convert a RawLedger to a canonicalised, cached and filtered Ledger+-- based on the command-line options/arguments and a reference time.+filterAndCacheLedgerWithOpts ::  [Opt] -> [String] -> LocalTime -> String -> RawLedger -> Ledger+filterAndCacheLedgerWithOpts opts args t = filterAndCacheLedger (optsToIOArgs opts args t) -parseWithCtx :: GenParser Char LedgerFileCtx a -> String -> Either ParseError a-parseWithCtx p ts = runParser p emptyCtx "" ts

@@ -5,7 +5,7 @@ import Options (progname)  -- updated by build process from VERSION-version       = "0.4.0"+version       = "0.5.0" #ifdef PATCHES -- a "make" development build defines PATCHES from the repo state patchlevel = "." ++ show PATCHES -- must be numeric !

@@ -26,6 +26,7 @@ import BalanceCommand import RegisterCommand import PrintCommand+import HistogramCommand   tcpport = 5000@@ -40,7 +41,7 @@        putStrLn $ printf "starting web server on port %d" tcpport        tid <- forkIO $ simpleHTTP nullConf{port=tcpport} handlers        putStrLn "starting web browser"-       openBrowserOn $ printf "http://localhost:%s/balance" (show tcpport)+       openBrowserOn $ printf "http://localhost:%d/balance" tcpport        waitForTermination        putStrLn "shutting down web server..."        killThread tid@@ -49,18 +50,25 @@     where       handlers :: ServerPartT IO Response       handlers = msum-       [dir "print" $ withDataFn (look "a") $ \a -> templatise $ printreport [a]+       [methodSP GET $ withDataFn (look "a") $ \a -> templatise $ balancereport [a]+       ,methodSP GET $ templatise $ balancereport []+       ,dir "print" $ withDataFn (look "a") $ \a -> templatise $ printreport [a]        ,dir "print" $ templatise $ printreport []        ,dir "register" $ withDataFn (look "a") $ \a -> templatise $ registerreport [a]        ,dir "register" $ templatise $ registerreport []        ,dir "balance" $ withDataFn (look "a") $ \a -> templatise $ balancereport [a]        ,dir "balance" $ templatise $ balancereport []+       ,dir "histogram" $ withDataFn (look "a") $ \a -> templatise $ histogramreport [a]+       ,dir "histogram" $ templatise $ histogramreport []        ]-      printreport apats    = showEntries opts (apats ++ args) l+      printreport apats    = showLedgerTransactions opts (apats ++ args) l       registerreport apats = showRegisterReport opts (apats ++ args) l       balancereport []  = showBalanceReport opts args l       balancereport apats  = showBalanceReport opts (apats ++ args) l'           where l' = cacheLedger apats (rawledger l) -- re-filter by account pattern each time+      histogramreport []  = showHistogram opts args l+      histogramreport apats  = showHistogram opts (apats ++ args) l'+          where l' = cacheLedger apats (rawledger l) -- re-filter by account pattern each time  templatise :: String -> ServerPartT IO Response templatise s = do@@ -78,6 +86,8 @@   ," <a href=register>register</a>"   ,"|"   ," <a href=print>print</a>"+  ,"|"+  ," <a href=histogram>histogram</a>"   ,"</div>"   ,"<pre>%s</pre>"   ])

@@ -1,6 +1,6 @@ Name:           hledger -- updated by build process from VERSION-Version:        0.4+Version:        0.5 Category:       Finance Synopsis:       A ledger-compatible text-based accounting tool. Description:    hledger is a partial haskell clone of John Wiegley's "ledger" text-based@@ -28,7 +28,7 @@  Library   Build-Depends:  base, containers, haskell98, directory, parsec, regex-compat,-                  old-locale, time, HUnit, filepath+                  old-locale, time, HUnit, filepath, utf8-string    Exposed-modules:Ledger                   Ledger.Account@@ -36,10 +36,11 @@                   Ledger.Amount                   Ledger.Commodity                   Ledger.Dates-                  Ledger.Entry+                  Ledger.IO+                  Ledger.LedgerTransaction                   Ledger.RawLedger                   Ledger.Ledger-                  Ledger.RawTransaction+                  Ledger.Posting                   Ledger.Parse                   Ledger.TimeLog                   Ledger.Transaction@@ -51,10 +52,13 @@    Build-Depends:  base, containers, haskell98, directory, parsec,                   regex-compat, regexpr>=0.5.1, old-locale, time,-                  HUnit, mtl, bytestring, filepath, process, testpack+                  HUnit, mtl, bytestring, filepath, process, testpack,+                  regex-pcre, csv, split, utf8-string    Other-Modules:  +                  AddCommand                   BalanceCommand+                  HistogramCommand                   Options                   PrintCommand                   RegisterCommand@@ -68,17 +72,18 @@                   Ledger.Amount                   Ledger.Commodity                   Ledger.Dates-                  Ledger.Entry+                  Ledger.IO+                  Ledger.LedgerTransaction                   Ledger.Ledger                   Ledger.Parse                   Ledger.RawLedger-                  Ledger.RawTransaction+                  Ledger.Posting                   Ledger.TimeLog                   Ledger.Transaction                   Ledger.Types                   Ledger.Utils -  -- how to set patchlevel in cabal builds ?+  -- need to set patchlevel here (darcs changes --from-tag=. --count)   cpp-options:    -DPATCHES=0    if flag(vty)

@@ -9,7 +9,7 @@ hledger is a partial haskell clone of John Wiegley's "ledger" text-based accounting tool.  It generates ledger-compatible register & balance reports from a plain text journal, and demonstrates a functional-implementation of ledger.  For more information, see ledger.org .+implementation of ledger.  For more information, see http:\/\/hledger.org .  You can use the command line: @@ -18,18 +18,21 @@ or ghci:  > $ ghci hledger-> > l <- ledgerfromfilewithopts [] [] "sample.ledger"-> > balance [] [] l->                  $-1  assets->                   $2  expenses->                  $-2  income->                   $1  liabilities+> > l <- readLedger "sample.ledger" > > register [] ["income","expenses"] l > 2008/01/01 income               income:salary                   $-1          $-1 > 2008/06/01 gift                 income:gifts                    $-1          $-2 > 2008/06/03 eat & shop           expenses:food                    $1          $-1 >                                 expenses:supplies                $1            0+> > balance [Depth "1"] [] l+>                  $-1  assets+>                   $2  expenses+>                  $-2  income+>                   $1  liabilities+> > l <- myLedger+> > t <- myTimelog +See "Ledger.Ledger" for more examples. -}  module Main (@@ -38,25 +41,36 @@              module Utils,              module Options,              module BalanceCommand,+             module ConvertCommand,              module PrintCommand,              module RegisterCommand,+             module HistogramCommand,+             module AddCommand,+#ifdef VTY+             module UICommand,+#endif #ifdef HAPPS              module WebCommand, #endif ) where+import Prelude hiding (putStr) import Control.Monad.Error import qualified Data.Map as Map (lookup)-import System.IO+import System.IO.UTF8+import System.IO (stderr)  import Version (versionmsg) import Ledger-import Utils+import Utils (withLedgerDo) import Options import Tests import BalanceCommand+import ConvertCommand import PrintCommand import RegisterCommand+import HistogramCommand+import AddCommand #ifdef VTY import UICommand #endif@@ -71,29 +85,20 @@   run cmd opts args     where        run cmd opts args-       | Help `elem` opts            = putStr $ usage-       | Version `elem` opts         = putStr versionmsg-       | cmd `isPrefixOf` "balance"  = parseLedgerAndDo opts args balance-       | cmd `isPrefixOf` "print"    = parseLedgerAndDo opts args print'-       | cmd `isPrefixOf` "register" = parseLedgerAndDo opts args register+       | Help `elem` opts             = putStr $ usage+       | Version `elem` opts          = putStr versionmsg+       | cmd `isPrefixOf` "balance"   = withLedgerDo opts args cmd balance+       | cmd `isPrefixOf` "convert"   = withLedgerDo opts args cmd convert+       | cmd `isPrefixOf` "print"     = withLedgerDo opts args cmd print'+       | cmd `isPrefixOf` "register"  = withLedgerDo opts args cmd register+       | cmd `isPrefixOf` "histogram" = withLedgerDo opts args cmd histogram+       | cmd `isPrefixOf` "add"       = withLedgerDo opts args cmd add #ifdef VTY-       | cmd `isPrefixOf` "ui"       = parseLedgerAndDo opts args ui+       | cmd `isPrefixOf` "ui"        = withLedgerDo opts args cmd ui #endif #ifdef HAPPS-       | cmd `isPrefixOf` "web"      = parseLedgerAndDo opts args web+       | cmd `isPrefixOf` "web"       = withLedgerDo opts args cmd web #endif-       | cmd `isPrefixOf` "test"     = runtests opts args >> return ()-       | otherwise                   = putStr $ usage+       | cmd `isPrefixOf` "test"      = runtests opts args >> return ()+       | otherwise                    = putStr $ usage --- | parse the user's specified ledger file and do some action with it--- (or report a parse error). This function makes the whole thing go.-parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()-parseLedgerAndDo opts args cmd = do-  f <- ledgerFilePathFromOpts opts-  -- XXX we read the file twice - inelegant-  -- and, doesn't work with stdin. kludge it, stdin won't work with ui command-  let f' = if f == "-" then "/dev/null" else f-  rawtext <- readFile f'-  t <- getCurrentLocalTime-  let runcmd = cmd opts args . prepareLedger opts args t rawtext-  return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) runcmd