hledger-lib 0.24.1 → 0.25

raw patch · 16 files changed

+183/−85 lines, 16 filesdep +base-compatdep +mtl-compatdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: base-compat, mtl-compat

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• CHANGES +7/−1
• Hledger/Data/Amount.hs +12/−6
• Hledger/Data/Dates.hs +22/−5
• Hledger/Data/OutputFormat.hs +4/−1
• Hledger/Data/TimeLog.hs +9/−1
• Hledger/Data/Types.hs +3/−3
• Hledger/Read.hs +3/−3
• Hledger/Read/CsvReader.hs +28/−15
• Hledger/Read/JournalReader.hs +33/−28
• Hledger/Read/TimelogReader.hs +4/−4
• Hledger/Reports/MultiBalanceReports.hs +18/−6
• Hledger/Reports/ReportOptions.hs +3/−0
• Hledger/Utils.hs +12/−2
• Hledger/Utils/Regex.hs +1/−1
• Hledger/Utils/UTF8IOCompat.hs +1/−1
• hledger-lib.cabal +23/−8

@@ -1,4 +1,10 @@-API-ish changes in hledger-lib. For user-visible changes, see hledger.+API-ish changes in hledger-lib.+User-visible changes appear in hledger's change log.+++0.25 (2015/4/7)++- GHC 7.10 compatibility (#239)  0.24.1 (2015/3/15) 

@@ -80,6 +80,7 @@   -- ** arithmetic   costOfMixedAmount,   divideMixedAmount,+  averageMixedAmounts,   isNegativeMixedAmount,   isZeroMixedAmount,   isReallyZeroMixedAmount,@@ -99,8 +100,10 @@ ) where  import Data.Char (isDigit)-#ifndef DOUBLE-import Data.Decimal+#ifdef DOUBLE+roundTo = flip const+#else+import Data.Decimal (roundTo) #endif import Data.Function (on) import Data.List@@ -149,10 +152,8 @@ missingamt :: Amount missingamt = amount{acommodity="AUTO"} --- handy amount constructors for tests-#ifdef DOUBLE-roundTo = flip const-#endif+-- Handy amount constructors for tests.+-- usd/eur/gbp round their argument to a whole number of pennies/cents. num n = amount{acommodity="",  aquantity=n} hrs n = amount{acommodity="h", aquantity=n,           astyle=amountstyle{asprecision=2, ascommodityside=R}} usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}}@@ -479,6 +480,11 @@ -- | Divide a mixed amount's quantities by a constant. divideMixedAmount :: MixedAmount -> Quantity -> MixedAmount divideMixedAmount (Mixed as) d = Mixed $ map (flip divideAmount d) as++-- | Calculate the average of some mixed amounts.+averageMixedAmounts :: [MixedAmount] -> MixedAmount+averageMixedAmounts [] = 0+averageMixedAmounts as = sum as `divideMixedAmount` fromIntegral (length as)  -- | Is this mixed amount negative, if it can be normalised to a single commodity ? isNegativeMixedAmount :: MixedAmount -> Maybe Bool

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE FlexibleContexts #-} {-|@@ -63,18 +64,24 @@ ) where -import Control.Applicative ((<*))+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative.Compat ((<*))+#endif import Control.Monad import Data.List import Data.Maybe+#if MIN_VERSION_time(1,5,0)+import Data.Time.Format hiding (months)+#else import Data.Time.Format+import System.Locale (TimeLocale, defaultTimeLocale)+#endif import Data.Time.Calendar import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate import Data.Time.Clock import Data.Time.LocalTime import Safe (headMay, lastMay, readMay)-import System.Locale (defaultTimeLocale) import Test.HUnit import Text.Parsec import Text.Printf@@ -420,13 +427,23 @@ --     parseTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" s --     ] +parsetime :: ParseTime t => TimeLocale -> String -> String -> Maybe t+parsetime =+#if MIN_VERSION_time(1,5,0)+     parseTimeM True+#else+     parseTime+#endif++ -- | Parse a couple of date string formats to a time type. parsedateM :: String -> Maybe Day parsedateM s = firstJust [-     parseTime defaultTimeLocale "%Y/%m/%d" s,-     parseTime defaultTimeLocale "%Y-%m-%d" s+     parsetime defaultTimeLocale "%Y/%m/%d" s,+     parsetime defaultTimeLocale "%Y-%m-%d" s      ] + -- -- | Parse a date-time string to a time type, or raise an error. -- parsedatetime :: String -> LocalTime -- parsedatetime s = fromMaybe (error' $ "could not parse timestamp \"" ++ s ++ "\"")@@ -440,7 +457,7 @@ -- | Parse a time string to a time type using the provided pattern, or -- return the default. parsetimewith :: ParseTime t => String -> String -> t -> t-parsetimewith pat s def = fromMaybe def $ parseTime defaultTimeLocale pat s+parsetimewith pat s def = fromMaybe def $ parsetime defaultTimeLocale pat s  {-| Parse a date in any of the formats allowed in ledger's period expressions,

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-} module Hledger.Data.OutputFormat (           parseStringFormat         , formatsp@@ -8,8 +9,10 @@         , tests         ) where -import Control.Applicative ((<*)) import Numeric+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative.Compat ((<*))+#endif import Data.Char (isPrint) import Data.Maybe import Test.HUnit

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-|  A 'TimeLogEntry' is a clock-in, clock-out, or other directive in a timelog@@ -13,7 +14,9 @@ import Data.Time.Clock import Data.Time.Format import Data.Time.LocalTime+#if !(MIN_VERSION_time(1,5,0)) import System.Locale (defaultTimeLocale)+#endif import Test.HUnit import Text.Printf @@ -109,7 +112,12 @@          nowstr = showtime now          yesterday = prevday today          clockin = TimeLogEntry nullsourcepos In-         mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S"+         mktime d = LocalTime d . fromMaybe midnight .+#if MIN_VERSION_time(1,5,0)+                    parseTimeM True defaultTimeLocale "%H:%M:%S"+#else+                    parseTime defaultTimeLocale "%H:%M:%S"+#endif          showtime = formatTime defaultTimeLocale "%H:%M"          assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ timeLogEntriesToTransactions now es) 

@@ -19,7 +19,7 @@  module Hledger.Data.Types where-import Control.Monad.Error (ErrorT)+import Control.Monad.Except (ExceptT) import Data.Data #ifndef DOUBLE import Data.Decimal@@ -200,7 +200,7 @@  -- | A JournalUpdate is some transformation of a Journal. It can do I/O or -- raise an error.-type JournalUpdate = ErrorT String IO (Journal -> Journal)+type JournalUpdate = ExceptT String IO (Journal -> Journal)  -- | The id of a data format understood by hledger, eg @journal@ or @csv@. type StorageFormat = String@@ -213,7 +213,7 @@      -- quickly check if this reader can probably handle the given file path and file content     ,rDetector :: FilePath -> String -> Bool      -- parse the given string, using the given parse rules file if any, returning a journal or error aware of the given file path-    ,rParser   :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal+    ,rParser   :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal     }  instance Show Reader where show r = rFormat r ++ " reader"

@@ -31,7 +31,7 @@ ) where import qualified Control.Exception as C-import Control.Monad.Error+import Control.Monad.Except import Data.List import Data.Maybe import System.Directory (doesFileExist, getHomeDirectory)@@ -127,7 +127,7 @@         firstSuccessOrBestError [] []        = return $ Left "no readers found"         firstSuccessOrBestError errs (r:rs) = do           dbgAtM 1 "trying reader" (rFormat r)-          result <- (runErrorT . (rParser r) rulesfile assrt path') s+          result <- (runExceptT . (rParser r) rulesfile assrt path') s           dbgAtM 1 "reader result" $ either id show result           case result of Right j -> return $ Right j                       -- success!                          Left e  -> firstSuccessOrBestError (errs++[e]) rs -- keep trying@@ -235,7 +235,7 @@    tests_Hledger_Read_CsvReader,     "journal" ~: do-    r <- runErrorT $ parseWithCtx nullctx JournalReader.journal ""+    r <- runExceptT $ parseWithCtx nullctx JournalReader.journal ""     assertBool "journal should parse an empty file" (isRight $ r)     jE <- readJournal Nothing Nothing True Nothing "" -- don't know how to get it from journal     either error' (assertBool "journal parsing an empty file should give an empty journal" . null . jtxns) jE

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-|  A reader for CSV data, using an extra rules file to help interpret the data.@@ -19,22 +20,28 @@   tests_Hledger_Read_CsvReader ) where-import Control.Applicative ((<$>), (<*))+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative.Compat ((<$>), (<*))+#endif import Control.Exception hiding (try) import Control.Monad-import Control.Monad.Error+import Control.Monad.Except -- import Test.HUnit import Data.Char (toLower, isDigit, isSpace) import Data.List import Data.Maybe import Data.Ord import Data.Time.Calendar (Day)+#if MIN_VERSION_time(1,5,0)+import Data.Time.Format (parseTimeM, defaultTimeLocale)+#else import Data.Time.Format (parseTime)+import System.Locale (defaultTimeLocale)+#endif import Safe import System.Directory (doesFileExist) import System.FilePath import System.IO (stderr)-import System.Locale (defaultTimeLocale) import Test.HUnit import Text.CSV (parseCSV, CSV) import Text.Parsec hiding (parse)@@ -63,7 +70,7 @@  -- | Parse and post-process a "Journal" from CSV data, or give an error. -- XXX currently ignores the string and reads from the file path-parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal+parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse rulesfile _ f s = do   r <- liftIO $ readJournalFromCsv rulesfile f s   case r of Left e -> throwError e@@ -92,7 +99,7 @@   if created    then hPrintf stderr "creating default conversion rules file %s, edit this file for better results\n" rulesfile    else hPrintf stderr "using conversion rules file %s\n" rulesfile-  rules_ <- liftIO $ runErrorT $ parseRulesFile rulesfile+  rules_ <- liftIO $ runExceptT $ parseRulesFile rulesfile   let rules = case rules_ of               Right (t::CsvRules) -> t               Left err -> throwerr $ show err@@ -335,15 +342,15 @@ getDirective directivename = lookup directivename . rdirectives  -parseRulesFile :: FilePath -> ErrorT String IO CsvRules+parseRulesFile :: FilePath -> ExceptT String IO CsvRules parseRulesFile f = do   s <- liftIO $ (readFile' f >>= expandIncludes (takeDirectory f))   let rules = parseCsvRules f s   case rules of-    Left e -> ErrorT $ return $ Left $ show e+    Left e -> ExceptT $ return $ Left $ show e     Right r -> do-               r_ <- liftIO $ runErrorT $ validateRules r-               ErrorT $ case r_ of+               r_ <- liftIO $ runExceptT $ validateRules r+               ExceptT $ case r_ of                  Left e -> return $ Left $ show $ toParseError e                  Right r -> return $ Right r   where@@ -369,13 +376,13 @@   runParser rulesp rules rulesfile s  -- | Return the validated rules, or an error.-validateRules :: CsvRules -> ErrorT String IO CsvRules+validateRules :: CsvRules -> ExceptT String IO CsvRules validateRules rules = do-  unless (isAssigned "date")   $ ErrorT $ return $ Left "Please specify (at top level) the date field. Eg: date %1\n"+  unless (isAssigned "date")   $ ExceptT $ return $ Left "Please specify (at top level) the date field. Eg: date %1\n"   unless ((amount && not (amountin || amountout)) ||           (not amount && (amountin && amountout)))-    $ ErrorT $ return $ Left "Please specify (at top level) either the amount field, or both the amount-in and amount-out fields. Eg: amount %2\n"-  ErrorT $ return $ Right rules+    $ ExceptT $ return $ Left "Please specify (at top level) either the amount field, or both the amount-in and amount-out fields. Eg: amount %2\n"+  ExceptT $ return $ Right rules   where     amount = isAssigned "amount"     amountin = isAssigned "amount-in"@@ -410,7 +417,7 @@ commentline = many spacenonewline >> commentchar >> restofline >> return () <?> "comment line"  commentchar :: Stream [Char] m t => ParsecT [Char] CsvRules m Char-commentchar = oneOf ";#"+commentchar = oneOf ";#*"  directive :: Stream [Char] m t => ParsecT [Char] CsvRules m (DirectiveName, String) directive = do@@ -713,7 +720,13 @@ parseDateWithFormatOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day parseDateWithFormatOrDefaultFormats mformat s = firstJust $ map parsewith formats   where-    parsewith = flip (parseTime defaultTimeLocale) s+    parsetime =+#if MIN_VERSION_time(1,5,0)+     parseTimeM True+#else+     parseTime+#endif+    parsewith = flip (parsetime defaultTimeLocale) s     formats = maybe                ["%Y/%-m/%-d"                ,"%Y-%-m-%-d"

@@ -45,10 +45,12 @@ #endif ) where-import Control.Applicative ((<*))+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative.Compat ((<*))+#endif import qualified Control.Exception as C import Control.Monad-import Control.Monad.Error+import Control.Monad.Except import Data.Char (isNumber) import Data.List import Data.List.Split (wordsBy)@@ -87,7 +89,7 @@  -- | Parse and post-process a "Journal" from hledger's journal file -- format, or give an error.-parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal+parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse _ = parseJournalWith journal  -- parsing utils@@ -98,7 +100,7 @@  -- | Given a JournalUpdate-generating parsec parser, file path and data string, -- parse and post-process a Journal so that it's ready to use, or give an error.-parseJournalWith :: (ParsecT [Char] JournalContext (ErrorT String IO) (JournalUpdate,JournalContext)) -> Bool -> FilePath -> String -> ErrorT String IO Journal+parseJournalWith :: (ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate,JournalContext)) -> Bool -> FilePath -> String -> ExceptT String IO Journal parseJournalWith p assrt f s = do   tc <- liftIO getClockTime   tl <- liftIO getCurrentLocalTime@@ -151,7 +153,7 @@ -- | Top-level journal parser. Returns a single composite, I/O performing, -- error-raising "JournalUpdate" (and final "JournalContext") which can be -- applied to an empty journal to get the final result.-journal :: ParsecT [Char] JournalContext (ErrorT String IO) (JournalUpdate,JournalContext)+journal :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate,JournalContext) journal = do   journalupdates <- many journalItem   eof@@ -171,7 +173,7 @@                            ] <?> "journal transaction or directive"  -- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives-directive :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+directive :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate directive = do   optional $ char '!'   choice' [@@ -189,7 +191,7 @@    ]   <?> "directive" -includedirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+includedirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate includedirective = do   string "include"   many1 spacenonewline@@ -197,7 +199,7 @@   outerState <- getState   outerPos <- getPosition   let curdir = takeDirectory (sourceName outerPos)-  let (u::ErrorT String IO (Journal -> Journal, JournalContext)) = do+  let (u::ExceptT String IO (Journal -> Journal, JournalContext)) = do        filepath <- expandPath curdir filename        txt <- readFileOrError outerPos filepath        let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"@@ -210,18 +212,18 @@                             return (u, ctx)          Left err -> throwError $ inIncluded ++ show err        where readFileOrError pos fp =-                ErrorT $ liftM Right (readFile' fp) `C.catch`+                ExceptT $ liftM Right (readFile' fp) `C.catch`                   \e -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show (e::C.IOException))-  r <- liftIO $ runErrorT u+  r <- liftIO $ runExceptT u   case r of     Left err -> return $ throwError err-    Right (ju, _finalparsectx) -> return $ ErrorT $ return $ Right ju+    Right (ju, _finalparsectx) -> return $ ExceptT $ return $ Right ju  journalAddFile :: (FilePath,String) -> Journal -> Journal journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}  -- NOTE: first encountered file to left, to avoid a reverse -accountdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+accountdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate accountdirective = do   string "account"   many1 spacenonewline@@ -229,16 +231,16 @@   newline   pushParentAccount parent   -- return $ return id-  return $ ErrorT $ return $ Right id+  return $ ExceptT $ return $ Right id -enddirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+enddirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate enddirective = do   string "end"   popParentAccount   -- return (return id)-  return $ ErrorT $ return $ Right id+  return $ ExceptT $ return $ Right id -aliasdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+aliasdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate aliasdirective = do   string "alias"   many1 spacenonewline@@ -249,13 +251,13 @@                   ,accountNameWithoutPostingType $ strip alias)   return $ return id -endaliasesdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+endaliasesdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate endaliasesdirective = do   string "end aliases"   clearAccountAliases   return (return id) -tagdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+tagdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate tagdirective = do   string "tag" <?> "tag directive"   many1 spacenonewline@@ -263,13 +265,13 @@   restofline   return $ return id -endtagdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+endtagdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate endtagdirective = do   (string "end tag" <|> string "pop") <?> "end tag or pop directive"   restofline   return $ return id -defaultyeardirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+defaultyeardirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate defaultyeardirective = do   char 'Y' <?> "default year"   many spacenonewline@@ -279,7 +281,7 @@   setYear y'   return $ return id -defaultcommoditydirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+defaultcommoditydirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate defaultcommoditydirective = do   char 'D' <?> "default commodity"   many1 spacenonewline@@ -288,7 +290,7 @@   restofline   return $ return id -historicalpricedirective :: ParsecT [Char] JournalContext (ErrorT String IO) HistoricalPrice+historicalpricedirective :: ParsecT [Char] JournalContext (ExceptT String IO) HistoricalPrice historicalpricedirective = do   char 'P' <?> "historical price"   many spacenonewline@@ -300,7 +302,7 @@   restofline   return $ HistoricalPrice date symbol price -ignoredpricecommoditydirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+ignoredpricecommoditydirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate ignoredpricecommoditydirective = do   char 'N' <?> "ignored-price commodity"   many1 spacenonewline@@ -308,7 +310,7 @@   restofline   return $ return id -commodityconversiondirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate+commodityconversiondirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate commodityconversiondirective = do   char 'C' <?> "commodity conversion"   many1 spacenonewline@@ -320,7 +322,7 @@   restofline   return $ return id -modifiertransaction :: ParsecT [Char] JournalContext (ErrorT String IO) ModifierTransaction+modifiertransaction :: ParsecT [Char] JournalContext (ExceptT String IO) ModifierTransaction modifiertransaction = do   char '=' <?> "modifier transaction"   many spacenonewline@@ -328,7 +330,7 @@   postings <- postings   return $ ModifierTransaction valueexpr postings -periodictransaction :: ParsecT [Char] JournalContext (ErrorT String IO) PeriodicTransaction+periodictransaction :: ParsecT [Char] JournalContext (ExceptT String IO) PeriodicTransaction periodictransaction = do   char '~' <?> "periodic transaction"   many spacenonewline@@ -337,7 +339,7 @@   return $ PeriodicTransaction periodexpr postings  -- | Parse a (possibly unbalanced) transaction.-transaction :: ParsecT [Char] JournalContext (ErrorT String IO) Transaction+transaction :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction transaction = do   -- ptrace "transaction"   sourcepos <- getPosition@@ -906,7 +908,10 @@      return $ unlines $ samelinecomment:newlinecomments  comment :: Stream [Char] m Char => ParsecT [Char] JournalContext m String-comment = commentStartingWith "#;"+comment = commentStartingWith commentchars++commentchars :: [Char]+commentchars = "#;*"  semicoloncomment :: Stream [Char] m Char => ParsecT [Char] JournalContext m String semicoloncomment = commentStartingWith ";"

@@ -48,7 +48,7 @@ ) where import Control.Monad-import Control.Monad.Error+import Control.Monad.Except import Data.List (isPrefixOf, foldl') import Test.HUnit import Text.Parsec hiding (parse)@@ -78,10 +78,10 @@ -- | Parse and post-process a "Journal" from timeclock.el's timelog -- format, saving the provided file path and the current time, or give an -- error.-parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal+parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse _ = parseJournalWith timelogFile -timelogFile :: ParsecT [Char] JournalContext (ErrorT String IO) (JournalUpdate, JournalContext)+timelogFile :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext) timelogFile = do items <- many timelogItem                  eof                  ctx <- getState@@ -98,7 +98,7 @@                           ] <?> "timelog entry, or default year or historical price directive"  -- | Parse a timelog entry.-timelogentry :: ParsecT [Char] JournalContext (ErrorT String IO) TimeLogEntry+timelogentry :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry timelogentry = do   sourcepos <- getPosition   code <- oneOf "bhioO"

@@ -41,7 +41,7 @@ -- (see 'BalanceType' and "Hledger.Cli.Balance"). newtype MultiBalanceReport = MultiBalanceReport ([DateSpan]                                                 ,[MultiBalanceReportRow]-                                                ,[MixedAmount]+                                                ,MultiBalanceTotalsRow                                                 )  -- | A row in a multi balance report has@@ -49,8 +49,14 @@ -- * An account name, with rendering hints -- -- * A list of amounts to be shown in each of the report's columns.-type MultiBalanceReportRow = (RenderableAccountName, [MixedAmount])+--+-- * The total of the row amounts.+--+-- * The average of the row amounts.+type MultiBalanceReportRow = (RenderableAccountName, [MixedAmount], MixedAmount, MixedAmount) +type MultiBalanceTotalsRow = ([MixedAmount], MixedAmount, MixedAmount)+ instance Show MultiBalanceReport where     -- use ppShow to break long lists onto multiple lines     -- we add some bogus extra shows here to help ppShow parse the output@@ -65,7 +71,7 @@ -- showing the change of balance, accumulated balance, or historical balance -- in each of the specified periods. multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport-multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totals)+multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow)     where       symq       = dbg "symq"   $ filterQuery queryIsSym $ dbg "requested q" q       depthq     = dbg "depthq" $ filterQuery queryIsDepth q@@ -144,23 +150,29 @@        items :: [MultiBalanceReportRow] =           dbg "items" $-          [((a, accountLeafName a, accountNameLevel a), displayedBals)+          [((a, accountLeafName a, accountNameLevel a), displayedBals, rowtot, rowavg)            | (a,changes) <- acctBalChanges            , let displayedBals = case balancetype_ opts of                                   HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes                                   CumulativeBalance -> drop 1 $ scanl (+) nullmixedamt changes                                   _                 -> changes+           , let rowtot = sum displayedBals+           , let rowavg = averageMixedAmounts displayedBals            , empty_ opts || depth == 0 || any (not . isZeroMixedAmount) displayedBals            ]        totals :: [MixedAmount] =-          dbg "totals" $+          -- dbg "totals" $           map sum balsbycol           where-            balsbycol = transpose [bs | ((a,_,_),bs) <- items, not (tree_ opts) || a `elem` highestlevelaccts]+            balsbycol = transpose [bs | ((a,_,_),bs,_,_) <- items, not (tree_ opts) || a `elem` highestlevelaccts]             highestlevelaccts     =                 dbg "highestlevelaccts" $                 [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a]++      totalsrow :: MultiBalanceTotalsRow =+          dbg "totalsrow" $+          (totals, sum totals, averageMixedAmounts totals)        dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg (p++" "++s)  -- add prefix in this function's debug output       -- dbg = const id  -- exclude this function from debug output

@@ -85,6 +85,7 @@     ,balancetype_    :: BalanceType     ,accountlistmode_  :: AccountListMode     ,drop_           :: Int+    ,row_total_      :: Bool     ,no_total_       :: Bool  } deriving (Show, Data, Typeable) @@ -117,6 +118,7 @@     def     def     def+    def  rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = do@@ -146,6 +148,7 @@     ,balancetype_ = balancetypeopt rawopts     ,accountlistmode_ = accountlistmodeopt rawopts     ,drop_        = intopt "drop" rawopts+    ,row_total_   = boolopt "row-total" rawopts     ,no_total_    = boolopt "no-total" rawopts     } 

@@ -29,8 +29,7 @@                           ) where import Control.Monad (liftM)-import Control.Monad.Error (MonadIO)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Char import Data.List import qualified Data.Map as M@@ -55,26 +54,34 @@  -- strings +lowercase, uppercase :: String -> String lowercase = map toLower uppercase = map toUpper  -- | Remove leading and trailing whitespace.+strip :: String -> String strip = lstrip . rstrip  -- | Remove leading whitespace.+lstrip :: String -> String lstrip = dropWhile (`elem` " \t") :: String -> String -- XXX isSpace ?  -- | Remove trailing whitespace.+rstrip :: String -> String rstrip = reverse . lstrip . reverse  -- | Remove trailing newlines/carriage returns.+chomp :: String -> String chomp = reverse . dropWhile (`elem` "\r\n") . reverse +stripbrackets :: String -> String stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String +elideLeft :: Int -> String -> String elideLeft width s =     if length s > width then ".." ++ reverse (take (width - 2) $ reverse s) else s +elideRight :: Int -> String -> String elideRight width s =     if length s > width then take (width - 2) s ++ ".." else s @@ -94,14 +101,17 @@  -- | Double-quote this string if it contains whitespace, single quotes -- or double-quotes, escaping the quotes as needed.+quoteIfNeeded :: String -> String quoteIfNeeded s | any (`elem` s) (quotechars++whitespacechars) = "\"" ++ escapeDoubleQuotes s ++ "\""                 | otherwise = s  -- | Single-quote this string if it contains whitespace or double-quotes. -- No good for strings containing single quotes.+singleQuoteIfNeeded :: String -> String singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'"                       | otherwise = s +quotechars, whitespacechars :: [Char] quotechars      = "'\"" whitespacechars = " \t\n\r" 

@@ -126,7 +126,7 @@ replaceAllBy :: Regex -> (String -> String) -> String -> String replaceAllBy re f s = start end   where-    (_, end, start) = foldl' go (0, s, id) $ getAllMatches $ match re s+    (_, end, start) = foldl' go (0, s, id) $ (getAllMatches $ match re s :: [(Int, Int)])     go (ind,read,write) (off,len) =       let (skip, start) = splitAt (off - ind) read           (matched, remaining) = splitAt len start

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+-- {-# LANGUAGE CPP #-} {- |  UTF-8 aware string IO functions that will work across multiple platforms

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.24.1+version: 0.25 stability:      stable category:       Finance, Console synopsis:       Core data types, parsers and utilities for the hledger accounting tool.@@ -17,7 +17,7 @@ maintainer:     Simon Michael <simon@joyful.com> homepage:       http://hledger.org bug-reports:    http://hledger.org/bugs-tested-with:    GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8.2+tested-with:    GHC==7.8.4, GHC==7.10.1 cabal-version:  >= 1.10 build-type:     Simple -- data-dir:       data@@ -35,10 +35,17 @@   location: https://github.com/simonmichael/hledger  flag double-    Description:   Use old Double number representation (instead of Decimal), for testing/benchmarking.-    Default:       False+    description:   Use old Double number representation (instead of Decimal), for testing/benchmarking.+    default:       False+    manual:        True +flag old-locale+  description: A compatibility flag, set automatically by cabal.+               If false then depend on time >= 1.5, +               if true then depend on time < 1.5 together with old-locale.+  default: False + library   -- should set patchlevel here as in Makefile   cpp-options: -DPATCHLEVEL=0@@ -82,6 +89,7 @@                   Hledger.Utils.UTF8IOCompat   build-depends:                   base >= 4.3 && < 5+                 ,base-compat >= 0.5.0                  ,array                  ,blaze-markup >= 0.5.1                  ,bytestring@@ -93,19 +101,22 @@                  ,directory                  ,filepath                  ,mtl-                 ,old-locale+                 ,mtl-compat                  ,old-time                  ,parsec >= 3                  ,regex-tdfa                  ,regexpr >= 0.5.1                  ,safe >= 0.2                  ,split >= 0.1 && < 0.3-                 ,time                  ,transformers >= 0.2 && < 0.5                  ,utf8-string >= 0.3.5 && < 1.1                  ,HUnit   if impl(ghc >= 7.4)     build-depends: pretty-show >= 1.6.4+  if flag(old-locale)+    build-depends: time < 1.5, old-locale+  else+    build-depends: time >= 1.5   test-suite tests@@ -117,6 +128,7 @@   default-language: Haskell2010   build-depends: hledger-lib                , base >= 4.3 && < 5+               , base-compat >= 0.5.0                , array                , blaze-markup >= 0.5.1                , cmdargs@@ -128,7 +140,7 @@                , filepath                , HUnit                , mtl-               , old-locale+               , mtl-compat                , old-time                , parsec >= 3                , regex-tdfa@@ -137,10 +149,13 @@                , split                , test-framework                , test-framework-hunit-               , time                , transformers   if impl(ghc >= 7.4)     build-depends: pretty-show >= 1.6.4+  if flag(old-locale)+    build-depends: time < 1.5, old-locale+  else+    build-depends: time >= 1.5  -- cf http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html