Fix a few spaceleaks (#413)

hledger-lib/Hledger/Data/Account.hs

@@ -64,7 +64,7 @@ accountsFromPostings ps =
     acctamts = [(paccount p,pamount p) | p <- ps]
     grouped = groupBy (\a b -> fst a == fst b) $ sort $ acctamts
     counted = [(a, length acctamts) | acctamts@((a,_):_) <- grouped]
-    summed = map (\as@((aname,_):_) -> (aname, sum $ map snd as)) grouped -- always non-empty
+    summed = map (\as@((aname,_):_) -> (aname, sumStrict $ map snd as)) grouped -- always non-empty
     nametree = treeFromPaths $ map (expandAccountName . fst) summed
     acctswithnames = nameTreeToAccount "root" nametree
     acctswithnumps = mapAccounts setnumps    acctswithnames where setnumps    a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted}

hledger-lib/Hledger/Data/Amount.hs

@@ -435,7 +435,7 @@ tests_normaliseMixedAmountSquashPricesForDisplay = [
 -- rendering helper.
 sumSimilarAmountsUsingFirstPrice :: [Amount] -> Amount
 sumSimilarAmountsUsingFirstPrice [] = nullamt
-sumSimilarAmountsUsingFirstPrice as = (sum as){aprice=aprice $ head as}
+sumSimilarAmountsUsingFirstPrice as = (sumStrict as){aprice=aprice $ head as}
 
 -- -- | Sum same-commodity amounts. If there were different prices, set
 -- -- the price to a special marker indicating "various". Only used as a

hledger-lib/Hledger/Data/Journal.hs

@@ -584,8 +584,8 @@ journalBalanceTransactionsST assrt j createStore storeIn extract =
     flip R.runReaderT (Env bals (storeIn txStore) assrt $
                        Just $ jinferredcommodities j) $ do
       dated <- fmap snd . sortBy (comparing fst) . concat
-             <$> mapM discriminateByDate (jtxns j)
-      mapM checkInferAndRegisterAmounts dated
+             <$> mapM' discriminateByDate (jtxns j)
+      mapM' checkInferAndRegisterAmounts dated
     lift $ extract txStore
   where size = genericLength $ journalPostings j
 
@@ -759,7 +759,7 @@ canonicalStyleFrom ss@(first:_) =
   where
     mgrps = maybe Nothing Just $ headMay $ catMaybes $ map asdigitgroups ss
     -- precision is maximum of all precisions
-    prec = maximum $ map asprecision ss
+    prec = maximumStrict $ map asprecision ss
     mdec  = Just $ headDef '.' $ catMaybes $ map asdecimalpoint ss
     -- precision is that of first amount with a decimal point
     -- (mdec, prec) =
@@ -842,8 +842,8 @@ journalDateSpan secondary j
     | null ts   = DateSpan Nothing Nothing
     | otherwise = DateSpan (Just earliest) (Just $ addDays 1 latest)
     where
-      earliest = minimum dates
-      latest   = maximum dates
+      earliest = minimumStrict dates
+      latest   = maximumStrict dates
       dates    = pdates ++ tdates
       tdates   = map (if secondary then transactionDate2 else tdate) ts
       pdates   = concatMap (catMaybes . map (if secondary then (Just . postingDate2) else pdate) . tpostings) ts

hledger-lib/Hledger/Data/Posting.hs

@@ -126,7 +126,7 @@ accountNamesFromPostings :: [Posting] -> [AccountName]
 accountNamesFromPostings = nub . map paccount
 
 sumPostings :: [Posting] -> MixedAmount
-sumPostings = sum . map pamount
+sumPostings = sumStrict . map pamount
 
 -- | Remove all prices of a posting
 removePrices :: Posting -> Posting

hledger-lib/Hledger/Data/Transaction.hs

@@ -393,10 +393,10 @@ inferBalancingAmount update t@Transaction{tpostings=ps}
            return t{tpostings=postings}
   where
     printerr s = intercalate "\n" [s, showTransactionUnelided t]
-    ((amountfulrealps, amountlessrealps), realsum) =
-      (partition hasAmount (realPostings t), sum $ map pamount amountfulrealps)
-    ((amountfulbvps, amountlessbvps), bvsum)       =
-      (partition hasAmount (balancedVirtualPostings t), sum $ map pamount amountfulbvps)
+    (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)
+    realsum = sumStrict $ map pamount amountfulrealps
+    (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)
+    bvsum = sumStrict $ map pamount amountfulbvps
     inferamount p@Posting{ptype=RegularPosting}
      | not (hasAmount p) = updateAmount p realsum
     inferamount p@Posting{ptype=BalancedVirtualPosting}
@@ -460,7 +460,7 @@ priceInferrerFor t pt = inferprice
     pmixedamounts  = map pamount postings
     pamounts       = concatMap amounts pmixedamounts
     pcommodities   = map acommodity pamounts
-    sumamounts     = amounts $ sum pmixedamounts -- sum normalises to one amount per commodity & price
+    sumamounts     = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price
     sumcommodities = map acommodity sumamounts
     sumprices      = filter (/=NoPrice) $ map aprice sumamounts
     caninferprices = length sumcommodities == 2 && null sumprices

hledger-lib/Hledger/Data/Types.hs

@@ -130,7 +130,7 @@ instance NFData Price
 data AmountStyle = AmountStyle {
       ascommodityside   :: Side,                 -- ^ does the symbol appear on the left or the right ?
       ascommodityspaced :: Bool,                 -- ^ space between symbol and quantity ?
-      asprecision       :: Int,                  -- ^ number of digits displayed after the decimal point
+      asprecision       :: !Int,                 -- ^ number of digits displayed after the decimal point
       asdecimalpoint    :: Maybe Char,           -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default"
       asdigitgroups     :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any
 } deriving (Eq,Ord,Read,Show,Typeable,Data,Generic)

hledger-lib/Hledger/Utils.hs

@@ -34,7 +34,7 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c
 where
 import Control.Monad (liftM)
 -- import Data.Char
--- import Data.List
+import Data.List
 -- import Data.Maybe
 -- import Data.PPrint
 import Data.Text (Text)
@@ -173,4 +173,39 @@ readFileOrStdinAnyLineEnding f = do
 -- | Total version of maximum, for integral types, giving 0 for an empty list.
 maximum' :: Integral a => [a] -> a
 maximum' [] = 0
-maximum' xs = maximum xs
+maximum' xs = maximumStrict xs
+
+-- | Strict version of sum that doesn’t leak space
+{-# INLINABLE sumStrict #-}
+sumStrict :: Num a => [a] -> a
+sumStrict = foldl' (+) 0
+
+-- | Strict version of maximum that doesn’t leak space
+{-# INLINABLE maximumStrict #-}
+maximumStrict :: Ord a => [a] -> a
+maximumStrict = foldl1' max
+
+-- | Strict version of minimum that doesn’t leak space
+{-# INLINABLE minimumStrict #-}
+minimumStrict :: Ord a => [a] -> a
+minimumStrict = foldl1' min
+
+-- | This is a version of sequence based on difference lists. It is
+-- slightly faster but we mostly use it because it uses the heap
+-- instead of the stack. This has the advantage that Neil Mitchell’s
+-- trick of limiting the stack size to discover space leaks doesn’t
+-- show this as a false positive.
+{-# INLINABLE sequence' #-}
+sequence' :: Monad f => [f a] -> f [a]
+sequence' ms = do
+  h <- go id ms
+  return (h [])
+  where
+    go h [] = return h
+    go h (m:ms) = do
+      x <- m
+      go (h . (x :)) ms
+
+{-# INLINABLE mapM' #-}
+mapM' :: Monad f => (a -> f b) -> [a] -> f [b]
+mapM' f = sequence' . map f

hledger/Hledger/Cli/Register.hs

@@ -90,8 +90,8 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,desc,acct,amt,bal]
 postingsReportAsText :: CliOpts -> PostingsReport -> String
 postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText opts amtwidth balwidth) items
   where
-    amtwidth = maximum $ 12 : map (strWidth . showMixedAmount . itemamt) items
-    balwidth = maximum $ 12 : map (strWidth . showMixedAmount . itembal) items
+    amtwidth = maximumStrict $ 12 : map (strWidth . showMixedAmount . itemamt) items
+    balwidth = maximumStrict $ 12 : map (strWidth . showMixedAmount . itembal) items
     itemamt (_,_,_,Posting{pamount=a},_) = a
     itembal (_,_,_,_,a) = a