Merge Xitian9/reporttext (#1427)

Many parts of the hledger-lib and hledger APIs have become more Text-ified,
expecting or returning Text instead of String.

Some functions now use WideBuilder (a text "builder" which keeps track
of width), to concatenate text more efficiently. There are some
helpers for converting to and from WideBuilder (wbUnpack, wbToText..)

showAmountB/showMixedAmountB are new amount-displaying functions
taking an AmountDisplayOpts. These will probably replace the old
show(Mixed)Amount* functions.

This reduces hledger's time and resident memory requirements by roughly 10%.

bin/hledger-balance-as-budget.hs

@@ -5,7 +5,8 @@
 
 {-| Construct two balance reports for two different time periods and use one of the as "budget" for
     the other, thus comparing them
--}  
+-}
+import Data.Text.Lazy.IO as TL
 import System.Environment (getArgs)
 import Hledger.Cli
 
@@ -34,7 +35,7 @@ main = do
   (_,_,report1) <- mbReport report1args
   (ropts2,j,report2) <- mbReport report2args
   let pastAsBudget = combineBudgetAndActual ropts2 j report1{prDates=prDates report2} report2
-  putStrLn $ budgetReportAsText ropts2 pastAsBudget
+  TL.putStrLn $ budgetReportAsText ropts2 pastAsBudget
   where
     mbReport args = do
       opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' cmdmode args

bin/hledger-check-fancyassertions.hs

@@ -70,7 +70,8 @@ hledger-check-fancyassertions "(assets:overdraft  < £2000) ==> (*assets:checkin
 my checking account (including subaccounts)."
 -}
 
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports    #-}
 
 module Main where
 
@@ -86,7 +87,9 @@ import Data.List.NonEmpty (NonEmpty(..), nonEmpty, toList)
 import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Time.Calendar (toGregorian)
 import Data.Time.Calendar.OrdinalDate (mondayStartWeek, sundayStartWeek, toOrdinalDate)
-import Data.Text (isPrefixOf, pack, unpack)
+import Data.Text (Text, isPrefixOf, pack, unpack)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import qualified Hledger.Data as H
 import qualified Hledger.Query as H
 import qualified Hledger.Read as H
@@ -124,17 +127,17 @@ main = do
 -- | Check assertions against a collection of grouped postings:
 -- assertions must hold when all postings in the group have been
 -- applied. Print out errors as they are found.
-checkAssertions :: [(H.AccountName, H.MixedAmount)] -> [(String, Predicate)] -> [NonEmpty H.Posting] -> IO Bool
+checkAssertions :: [(H.AccountName, H.MixedAmount)] -> [(Text, Predicate)] -> [NonEmpty H.Posting] -> IO Bool
 checkAssertions balances0 asserts0 postingss
     | null failed = pure True
-    | otherwise = putStrLn (intercalate "\n\n" failed) >> pure False
+    | otherwise = T.putStrLn (T.intercalate "\n\n" failed) >> pure False
   where
     (_, _, failed) = foldl' applyAndCheck (balances0, asserts0, []) postingss
 
     -- Apply a collection of postings and check the assertions.
-    applyAndCheck :: ([(H.AccountName, H.MixedAmount)], [(String, Predicate)], [String])
+    applyAndCheck :: ([(H.AccountName, H.MixedAmount)], [(Text, Predicate)], [Text])
                   -> NonEmpty H.Posting
-                  -> ([(H.AccountName, H.MixedAmount)], [(String, Predicate)], [String])
+                  -> ([(H.AccountName, H.MixedAmount)], [(Text, Predicate)], [Text])
     applyAndCheck (starting, asserts, errs) ps =
       let ps' = toList ps
           closing  = starting `addAccounts` closingBalances' ps'
@@ -145,25 +148,25 @@ checkAssertions balances0 asserts0 postingss
 
     -- Check an assertion against a collection of account balances,
     -- and return an error on failure.
-    check :: H.Posting -> [(H.AccountName, H.MixedAmount)] -> (String, Predicate) -> Maybe String
+    check :: H.Posting -> [(H.AccountName, H.MixedAmount)] -> (Text, Predicate) -> Maybe Text
     check lastp balances (pstr, p)
       | checkAssertion balances p = Nothing
-      | otherwise = Just . unlines $
+      | otherwise = Just . T.unlines $
           let after = case H.ptransaction lastp of
                 Just t  ->
-                  "after transaction:\n" ++ H.showTransaction t ++
+                  "after transaction:\n" <> H.showTransaction t <>
-                  "(after posting: " ++ init (H.showPosting lastp) ++ ")\n\n"
+                  "(after posting: " <> T.pack (init $ H.showPosting lastp) <> ")\n\n"
                 Nothing ->
-                  "after posting:\n" ++ H.showPosting lastp
+                  "after posting:\n" <> T.pack (H.showPosting lastp)
 
               -- Restrict to accounts mentioned in the predicate, and pretty-print balances
-              balances' = map (first unpack) $ filter (flip inAssertion p . fst) balances
+              balances' = filter (flip inAssertion p . fst) balances
-              maxalen   = maximum $ map (length . fst) balances'
+              maxalen   = maximum $ map (T.length . fst) balances'
-              accounts = [ a <> padding <> show m
+              accounts = [ a <> padding <> T.pack (show m)
                          | (a,m) <- balances'
-                         , let padding = replicate (2 + maxalen - length a) ' '
+                         , let padding = T.replicate (2 + maxalen - T.length a) " "
                          ]
-          in [ "assertion '" ++ pstr ++ "' violated", after ++ "relevant balances:"] ++ map ("    "++) accounts
+          in [ "assertion '" <> pstr <> "' violated", after <> "relevant balances:"] ++ map ("    "<>) accounts
 
 -- | Check an assertion holds for a collection of account balances.
 checkAssertion :: [(H.AccountName, H.MixedAmount)] -> Predicate -> Bool
@@ -322,17 +325,17 @@ data Opts = Opts
     -- ^ Include only non-virtual postings.
     , sunday :: Bool
     -- ^ Week starts on Sunday.
-    , assertionsDaily :: [(String, Predicate)]
+    , assertionsDaily :: [(Text, Predicate)]
     -- ^ Account assertions that must hold at the end of each day.
-    , assertionsWeekly :: [(String, Predicate)]
+    , assertionsWeekly :: [(Text, Predicate)]
     -- ^ Account assertions that must hold at the end of each week.
-    , assertionsMonthly :: [(String, Predicate)]
+    , assertionsMonthly :: [(Text, Predicate)]
     -- ^ Account assertions that must hold at the end of each month.
-    , assertionsQuarterly :: [(String, Predicate)]
+    , assertionsQuarterly :: [(Text, Predicate)]
     -- ^ Account assertions that must hold at the end of each quarter.
-    , assertionsYearly :: [(String, Predicate)]
+    , assertionsYearly :: [(Text, Predicate)]
     -- ^ Account assertions that must hold at the end of each year.
-    , assertionsAlways :: [(String, Predicate)]
+    , assertionsAlways :: [(Text, Predicate)]
     -- ^ Account assertions that must hold after each txn.
     }
   deriving (Show)
@@ -388,13 +391,13 @@ args = info (helper <*> parser) $ mconcat
 
     -- Turn a Parsec parser into a ReadM parser that also returns the
     -- input.
-    readParsec :: H.JournalParser ReadM a -> ReadM (String, a)
+    readParsec :: H.JournalParser ReadM a -> ReadM (Text, a)
     readParsec p = do
       s <- str
-      parsed <- P.runParserT (runStateT p H.nulljournal) "" (pack s)
+      parsed <- P.runParserT (runStateT p H.nulljournal) "" s
       case parsed of
         Right (a, _) -> pure (s, a)
-        Left err -> fail ("failed to parse input '" ++ s ++ "': " ++ show err)
+        Left err -> fail ("failed to parse input '" ++ unpack s ++ "': " ++ show err)
 
     readParsec' :: H.SimpleTextParser a -> ReadM (String, a)
     readParsec' p = do

bin/hledger-combine-balances.hs

@@ -9,6 +9,7 @@ import System.Environment (getArgs)
 import Hledger.Cli
 import qualified Data.Map as M
 import Data.Map.Merge.Strict
+import qualified Data.Text.Lazy.IO as TL
 
 appendReports :: MultiBalanceReport -> MultiBalanceReport -> MultiBalanceReport
 appendReports r1 r2 =
@@ -62,7 +63,7 @@ main = do
   (_,report1) <- mbReport report1args
   (rspec2,report2) <- mbReport report2args
   let merged = appendReports report1 report2
-  putStrLn $ multiBalanceReportAsText (rsOpts rspec2) merged
+  TL.putStrLn $ multiBalanceReportAsText (rsOpts rspec2) merged
   where
     mbReport args = do
       opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' cmdmode args

bin/hledger-smooth.hs

@@ -69,7 +69,7 @@ main = do
       pr = postingsReport rspec{rsQuery = And [Acct $ accountNameToAccountRegexCI acct, q]} j
 
       -- dates of postings to acct (in report)
-      pdates = map (postingDate . fourth5) (snd pr)
+      pdates = map (postingDate . fourth5) pr
       -- the specified report end date or today's date
       enddate = fromMaybe today menddate
       dates = pdates ++ [enddate]

bin/hledger-swap-dates.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE RecordWildCards #-}
 
 import Data.String.QQ (s)
+import qualified Data.Text.IO as T
 import Hledger
 import Hledger.Cli
 
@@ -33,7 +34,7 @@ main = do
       q = rsQuery rspec
       ts = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j
       ts' = map transactionSwapDates ts
-    mapM_ (putStrLn . showTransaction) ts'
+    mapM_ (T.putStrLn . showTransaction) ts'
 
 transactionSwapDates :: Transaction -> Transaction
 transactionSwapDates t@Transaction{tdate2=Nothing} = t

hledger-lib/Hledger/Data/Account.hs

@@ -30,8 +30,8 @@ instance Show Account where
                        aname
                        (if aboring then "y" else "n" :: String)
                        anumpostings
-                       (showMixedAmount aebalance)
+                       (wbUnpack $ showMixedAmountB noColour aebalance)
-                       (showMixedAmount aibalance)
+                       (wbUnpack $ showMixedAmountB noColour aibalance)
 
 instance Eq Account where
   (==) a b = aname a == aname b -- quick equality test for speed
@@ -265,6 +265,6 @@ showAccountsBoringFlag = unlines . map (show . aboring) . flattenAccounts
 
 showAccountDebug a = printf "%-25s %4s %4s %s"
                      (aname a)
-                     (showMixedAmount $ aebalance a)
+                     (wbUnpack . showMixedAmountB noColour $ aebalance a)
-                     (showMixedAmount $ aibalance a)
+                     (wbUnpack . showMixedAmountB noColour $ aibalance a)
                      (if aboring a then "b" else " " :: String)

hledger-lib/Hledger/Data/AccountName.hs

@@ -208,31 +208,31 @@ clipOrEllipsifyAccountName (Just 0) = const "..."
 clipOrEllipsifyAccountName n        = clipAccountName n
 
 -- | Escape an AccountName for use within a regular expression.
--- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
+-- >>> putStr . T.unpack $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
 -- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@#
-escapeName :: AccountName -> String
+escapeName :: AccountName -> Text
-escapeName = T.unpack . T.concatMap escapeChar
+escapeName = T.concatMap escapeChar
   where
     escapeChar c = if c `elem` escapedChars then T.snoc "\\" c else T.singleton c
     escapedChars = ['[', '?', '+', '|', '(', ')', '*', '$', '^', '\\']
 
 -- | Convert an account name to a regular expression matching it and its subaccounts.
 accountNameToAccountRegex :: AccountName -> Regexp
-accountNameToAccountRegex a = toRegex' $ '^' : escapeName a ++ "(:|$)"  -- PARTIAL: Is this safe after escapeName?
+accountNameToAccountRegex a = toRegex' $ "^" <> escapeName a <> "(:|$)"  -- PARTIAL: Is this safe after escapeName?
 
 -- | Convert an account name to a regular expression matching it and its subaccounts,
 -- case insensitively.
 accountNameToAccountRegexCI :: AccountName -> Regexp
-accountNameToAccountRegexCI a = toRegexCI' $ '^' : escapeName a ++ "(:|$)"  -- PARTIAL: Is this safe after escapeName?
+accountNameToAccountRegexCI a = toRegexCI' $ "^" <> escapeName a <> "(:|$)"  -- PARTIAL: Is this safe after escapeName?
 
 -- | Convert an account name to a regular expression matching it but not its subaccounts.
 accountNameToAccountOnlyRegex :: AccountName -> Regexp
-accountNameToAccountOnlyRegex a = toRegex' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName?
+accountNameToAccountOnlyRegex a = toRegex' $ "^" <> escapeName a <> "$" -- PARTIAL: Is this safe after escapeName?
 
 -- | Convert an account name to a regular expression matching it but not its subaccounts,
 -- case insensitively.
 accountNameToAccountOnlyRegexCI :: AccountName -> Regexp
-accountNameToAccountOnlyRegexCI a = toRegexCI' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName?
+accountNameToAccountOnlyRegexCI a = toRegexCI' $ "^" <> escapeName a <> "$" -- PARTIAL: Is this safe after escapeName?
 
 -- -- | Does this string look like an exact account-matching regular expression ?
 --isAccountRegex  :: String -> Bool

hledger-lib/Hledger/Data/Amount.hs

@@ -40,7 +40,10 @@ exchange rates.
 
 -}
 
-{-# LANGUAGE StandaloneDeriving, RecordWildCards, OverloadedStrings #-}
+{-# LANGUAGE CPP                #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RecordWildCards    #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Hledger.Data.Amount (
   -- * Amount
@@ -66,10 +69,15 @@ module Hledger.Data.Amount (
   multiplyAmountAndPrice,
   amountTotalPriceToUnitPrice,
   -- ** rendering
+  AmountDisplayOpts(..),
+  noColour,
+  noPrice,
+  oneLine,
   amountstyle,
   styleAmount,
   styleAmountExceptPrecision,
   amountUnstyled,
+  showAmountB,
   showAmount,
   cshowAmount,
   showAmountWithZeroCommodity,
@@ -117,11 +125,10 @@ module Hledger.Data.Amount (
   showMixedAmountOneLineWithoutPrice,
   showMixedAmountElided,
   showMixedAmountWithZeroCommodity,
-  showMixedAmountWithPrecision,
+  showMixedAmountB,
-  showMixed,
+  showMixedAmountLinesB,
-  showMixedUnnormalised,
+  wbToText,
-  showMixedOneLine,
+  wbUnpack,
-  showMixedOneLineUnnormalised,
   setMixedAmountPrecision,
   canonicaliseMixedAmount,
   -- * misc.
@@ -130,17 +137,22 @@ module Hledger.Data.Amount (
 ) where
 
 import Control.Monad (foldM)
-import Data.Char (isDigit)
+import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
-import Data.Decimal (decimalPlaces, normalizeDecimal, roundTo)
+import Data.Default (Default(..))
 import Data.Function (on)
-import Data.List (genericSplitAt, groupBy, intercalate, mapAccumL,
+import Data.List (groupBy, intercalate, intersperse, mapAccumL, partition,
-                  partition, sortBy)
+                  sortBy)
+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
 import qualified Data.Map as M
 import Data.Map (findWithDefault)
 import Data.Maybe (fromMaybe)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
 import qualified Data.Text as T
+import qualified Data.Text.Lazy.Builder as TB
 import Data.Word (Word8)
-import Safe (lastDef, lastMay)
+import Safe (headDef, lastDef, lastMay)
 import Text.Printf (printf)
 
 import Hledger.Data.Types
@@ -150,13 +162,45 @@ import Hledger.Utils
 deriving instance Show MarketPrice
 
 
+-- | Options for the display of Amount and MixedAmount.
+data AmountDisplayOpts = AmountDisplayOpts
+  { displayPrice         :: Bool       -- ^ Whether to display the Price of an Amount.
+  , displayZeroCommodity :: Bool       -- ^ If the Amount rounds to 0, whether to display its commodity string.
+  , displayColour        :: Bool       -- ^ Whether to colourise negative Amounts.
+  , displayNormalised    :: Bool       -- ^ Whether to normalise MixedAmounts before displaying.
+  , displayOneLine       :: Bool       -- ^ Whether to display on one line.
+  , displayMinWidth      :: Maybe Int  -- ^ Minimum width to pad to
+  , displayMaxWidth      :: Maybe Int  -- ^ Maximum width to clip to
+  } deriving (Show)
+
+-- | Display Amount and MixedAmount with no colour.
+instance Default AmountDisplayOpts where def = noColour
+
+-- | Display Amount and MixedAmount with no colour.
+noColour :: AmountDisplayOpts
+noColour = AmountDisplayOpts { displayPrice         = True
+                             , displayColour        = False
+                             , displayZeroCommodity = False
+                             , displayNormalised    = True
+                             , displayOneLine       = False
+                             , displayMinWidth      = Nothing
+                             , displayMaxWidth      = Nothing
+                             }
+
+-- | Display Amount and MixedAmount with no prices.
+noPrice :: AmountDisplayOpts
+noPrice = def{displayPrice=False}
+
+-- | Display Amount and MixedAmount on one line with no prices.
+oneLine :: AmountDisplayOpts
+oneLine = def{displayOneLine=True, displayPrice=False}
+
 -------------------------------------------------------------------------------
 -- Amount styles
 
 -- | Default amount style
 amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing
 
-
 -------------------------------------------------------------------------------
 -- Amount
 
@@ -327,10 +371,10 @@ setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalpoint=mc} }
 withDecimalPoint :: Amount -> Maybe Char -> Amount
 withDecimalPoint = flip setAmountDecimalPoint
 
-showAmountPrice :: Maybe AmountPrice -> String
+showAmountPrice :: Maybe AmountPrice -> WideBuilder
-showAmountPrice Nothing                = ""
+showAmountPrice Nothing      = mempty
-showAmountPrice (Just (UnitPrice pa))  = " @ "  ++ showAmount pa
+showAmountPrice (Just (UnitPrice  pa)) = WideBuilder (TB.fromString " @ ")  3 <> showAmountB noColour pa
-showAmountPrice (Just (TotalPrice pa)) = " @@ " ++ showAmount pa
+showAmountPrice (Just (TotalPrice pa)) = WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour pa
 
 showAmountPriceDebug :: Maybe AmountPrice -> String
 showAmountPriceDebug Nothing                = ""
@@ -361,40 +405,49 @@ amountUnstyled a = a{astyle=amountstyle}
 -- commodity's display settings. String representations equivalent to
 -- zero are converted to just \"0\". The special "missing" amount is
 -- displayed as the empty string.
+--
+-- > showAmount = wbUnpack . showAmountB noColour
 showAmount :: Amount -> String
-showAmount = showAmountHelper False
+showAmount = wbUnpack . showAmountB noColour
+
+-- | General function to generate a WideBuilder for an Amount, according the
+-- supplied AmountDisplayOpts. The special "missing" amount is displayed as
+-- the empty string. This is the main function to use for showing
+-- Amounts, constructing a builder; it can then be converted to a Text with
+-- wbToText, or to a String with wbUnpack.
+showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder
+showAmountB _ Amount{acommodity="AUTO"} = mempty
+showAmountB opts a@Amount{astyle=style} =
+    color $ case ascommodityside style of
+      L -> c' <> space <> quantity' <> price
+      R -> quantity' <> space <> c' <> price
+  where
+    quantity = showamountquantity a
+    (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"")
+                  | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)
+    space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty
+    c' = WideBuilder (TB.fromText c) (textWidth c)
+    price = if displayPrice opts then showAmountPrice (aprice a) else mempty
+    color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id
 
 -- | Colour version. For a negative amount, adds ANSI codes to change the colour,
 -- currently to hard-coded red.
+--
+-- > cshowAmount = wbUnpack . showAmountB def{displayColour=True}
 cshowAmount :: Amount -> String
-cshowAmount a = (if isNegativeAmount a then color Dull Red else id) $
+cshowAmount = wbUnpack . showAmountB def{displayColour=True}
-                showAmountHelper False a
 
 -- | Get the string representation of an amount, without any \@ price.
+--
+-- > showAmountWithoutPrice = wbUnpack . showAmountB noPrice
 showAmountWithoutPrice :: Amount -> String
-showAmountWithoutPrice a = showAmount a{aprice=Nothing}
+showAmountWithoutPrice = wbUnpack . showAmountB noPrice
-
--- | Get the string representation of an amount, based on its commodity's
--- display settings except using the specified precision.
-showAmountWithPrecision :: AmountPrecision -> Amount -> String
-showAmountWithPrecision p = showAmount . setAmountPrecision p
-
-showAmountHelper :: Bool -> Amount -> String
-showAmountHelper _ Amount{acommodity="AUTO"} = ""
-showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=mp, astyle=AmountStyle{..}} =
-    case ascommodityside of
-      L -> printf "%s%s%s%s" (T.unpack c') space quantity' price
-      R -> printf "%s%s%s%s" quantity' space (T.unpack c') price
-    where
-      quantity = showamountquantity a
-      (quantity',c') | amountLooksZero a && not showzerocommodity = ("0","")
-                     | otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
-      space = if not (T.null c') && ascommodityspaced then " " else "" :: String
-      price = showAmountPrice mp
 
 -- | Like showAmount, but show a zero amount's commodity if it has one.
+--
+-- > showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeryCommodity=True}
 showAmountWithZeroCommodity :: Amount -> String
-showAmountWithZeroCommodity = showAmountHelper True
+showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeroCommodity=True}
 
 -- | Get a string representation of an amount for debugging,
 -- appropriate to the current debug level. 9 shows maximum detail.
@@ -402,35 +455,40 @@ showAmountDebug :: Amount -> String
 showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
 showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showAmountPriceDebug aprice) (show astyle)
 
--- | Get the string representation of the number part of of an amount,
+-- | Get a Text Builder for the string representation of the number part of of an amount,
--- using the display settings from its commodity.
+-- using the display settings from its commodity. Also returns the width of the
-showamountquantity :: Amount -> String
+-- number.
+showamountquantity :: Amount -> WideBuilder
 showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} =
-    punctuatenumber (fromMaybe '.' mdec) mgrps . show $ amountRoundedQuantity amt
+    signB <> intB <> fracB
-
--- | Replace a number string's decimal mark with the specified
--- character, and add the specified digit group marks. The last digit
--- group will be repeated as needed.
-punctuatenumber :: Char -> Maybe DigitGroupStyle -> String -> String
-punctuatenumber dec mgrps s = sign ++ reverse (applyDigitGroupStyle mgrps (reverse int)) ++ frac''
-    where
-      (sign,num) = break isDigit s
-      (int,frac) = break (=='.') num
-      frac' = dropWhile (=='.') frac
-      frac'' | null frac' = ""
-             | otherwise  = dec:frac'
-
-applyDigitGroupStyle :: Maybe DigitGroupStyle -> String -> String
-applyDigitGroupStyle Nothing s = s
-applyDigitGroupStyle (Just (DigitGroups c gs)) s = addseps (repeatLast gs) s
   where
-    addseps [] s = s
+    Decimal e n = amountRoundedQuantity amt
-    addseps (g:gs) s
+
-      | toInteger (length s) <= toInteger g = s
+    strN = T.pack . show $ abs n
-      | otherwise     = let (part,rest) = genericSplitAt g s
+    len = T.length strN
-                        in part ++ c : addseps gs rest
+    intLen = max 1 $ len - fromIntegral e
-    repeatLast [] = []
+    dec = fromMaybe '.' mdec
-    repeatLast gs = init gs ++ repeat (last gs)
+    padded = T.replicate (fromIntegral e + 1 - len) "0" <> strN
+    (intPart, fracPart) = T.splitAt intLen padded
+
+    intB = applyDigitGroupStyle mgrps intLen $ if e == 0 then strN else intPart
+    signB = if n < 0 then WideBuilder (TB.singleton '-') 1 else mempty
+    fracB = if e > 0 then WideBuilder (TB.singleton dec <> TB.fromText fracPart) (fromIntegral e + 1) else mempty
+
+-- | Split a string representation into chunks according to DigitGroupStyle,
+-- returning a Text builder and the number of separators used.
+applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> WideBuilder
+applyDigitGroupStyle Nothing                       l s = WideBuilder (TB.fromText s) l
+applyDigitGroupStyle (Just (DigitGroups _ []))     l s = WideBuilder (TB.fromText s) l
+applyDigitGroupStyle (Just (DigitGroups c (g:gs))) l s = addseps (g:|gs) (toInteger l) s
+  where
+    addseps (g:|gs) l s
+        | l' > 0    = addseps gs' l' rest <> WideBuilder (TB.singleton c <> TB.fromText part) (fromIntegral g + 1)
+        | otherwise = WideBuilder (TB.fromText s) (fromInteger l)
+      where
+        (rest, part) = T.splitAt (fromInteger l') s
+        gs' = fromMaybe (g:|[]) $ nonEmpty gs
+        l' = l - toInteger g
 
 -- like journalCanonicaliseAmounts
 -- | Canonicalise an amount's display style using the provided commodity style map.
@@ -622,40 +680,46 @@ mixedAmountUnstyled = mapMixedAmount amountUnstyled
 -- | Get the string representation of a mixed amount, after
 -- normalising it to one amount per commodity. Assumes amounts have
 -- no or similar prices, otherwise this can show misleading prices.
+--
+-- > showMixedAmount = wbUnpack . showMixedAmountB noColour
 showMixedAmount :: MixedAmount -> String
-showMixedAmount = fst . showMixed showAmount Nothing Nothing False
+showMixedAmount = wbUnpack . showMixedAmountB noColour
 
 -- | Get the one-line string representation of a mixed amount.
+--
+-- > showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine
 showMixedAmountOneLine :: MixedAmount -> String
-showMixedAmountOneLine = fst . showMixedOneLine showAmountWithoutPrice Nothing Nothing False
+showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine
 
 -- | Like showMixedAmount, but zero amounts are shown with their
 -- commodity if they have one.
+--
+-- > showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True}
 showMixedAmountWithZeroCommodity :: MixedAmount -> String
-showMixedAmountWithZeroCommodity = fst . showMixed showAmountWithZeroCommodity Nothing Nothing False
+showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True}
-
--- | Get the string representation of a mixed amount, showing each of its
--- component amounts with the specified precision, ignoring their
--- commoditys' display precision settings.
-showMixedAmountWithPrecision :: AmountPrecision -> MixedAmount -> String
-showMixedAmountWithPrecision p = fst . showMixed (showAmountWithPrecision p) Nothing Nothing False
 
 -- | Get the string representation of a mixed amount, without showing any transaction prices.
 -- With a True argument, adds ANSI codes to show negative amounts in red.
+--
+-- > showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noPrice{displayColour=c}
 showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String
-showMixedAmountWithoutPrice c = fst . showMixed showAmountWithoutPrice Nothing Nothing c
+showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noPrice{displayColour=c}
 
 -- | Get the one-line string representation of a mixed amount, but without
 -- any \@ prices.
 -- With a True argument, adds ANSI codes to show negative amounts in red.
+--
+-- > showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c}
 showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String
-showMixedAmountOneLineWithoutPrice c = fst . showMixedOneLine showAmountWithoutPrice Nothing Nothing c
+showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c}
 
 -- | Like showMixedAmountOneLineWithoutPrice, but show at most the given width,
 -- with an elision indicator if there are more.
 -- With a True argument, adds ANSI codes to show negative amounts in red.
+--
+-- > showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}
 showMixedAmountElided :: Int -> Bool -> MixedAmount -> String
-showMixedAmountElided w c = fst . showMixedOneLine showAmountWithoutPrice Nothing (Just w) c
+showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}
 
 -- | Get an unambiguous string representation of a mixed amount for debugging.
 showMixedAmountDebug :: MixedAmount -> String
@@ -663,59 +727,65 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)"
                        | otherwise       = printf "Mixed [%s]" as
     where as = intercalate "\n       " $ map showAmountDebug $ amounts m
 
--- | General function to display a MixedAmount, one Amount on each line.
+-- | General function to generate a WideBuilder for a MixedAmount, according the
--- It takes a function to display each Amount, an optional minimum width
+-- supplied AmountDisplayOpts. This is the main function to use for showing
--- to pad to, an optional maximum width to display, and a Bool to determine
+-- MixedAmounts, constructing a builder; it can then be converted to a Text with
--- whether to colourise negative numbers. Amounts longer than the maximum
+-- wbToText, or to a String with wbUnpack.
--- width (if given) will be elided. The function also returns the actual
+--
--- width of the output string.
+-- If a maximum width is given then:
-showMixed :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)
+-- - If displayed on one line, it will display as many Amounts as can
-showMixed showamt mmin mmax c =
+--   fit in the given width, and further Amounts will be elided.
-    showMixedUnnormalised showamt mmin mmax c . normaliseMixedAmountSquashPricesForDisplay
+-- - If displayed on multiple lines, any Amounts longer than the
-
+--   maximum width will be elided.
--- | Like showMixed, but does not normalise the MixedAmount before displaying.
+showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder
-showMixedUnnormalised :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)
+showMixedAmountB opts ma
-showMixedUnnormalised showamt mmin mmax c (Mixed as) =
+    | displayOneLine opts = showMixedAmountOneLineB opts ma
-    (intercalate "\n" $ map finalise elided, width)
+    | otherwise           = WideBuilder (wbBuilder . mconcat $ intersperse sep lines) width
   where
-    width    = maximum $ fromMaybe 0 mmin : map adLength elided
+    lines = showMixedAmountLinesB opts ma
-    astrs    = amtDisplayList sepwidth showamt as
+    width = headDef 0 $ map wbWidth lines
-    sepwidth = 0  -- "\n" has width 0
+    sep = WideBuilder (TB.singleton '\n') 0
 
-    finalise = adString . pad . if c then colourise else id
+-- | Helper for showMixedAmountB to show a MixedAmount on multiple lines. This returns
-    pad amt = amt{ adString = applyN (width - adLength amt) (' ':) $ adString amt
+-- the list of WideBuilders: one for each Amount in the MixedAmount (possibly
-                 , adLength = width
+-- normalised), and padded/elided to the appropriate width. This does not
-                 }
+-- honour displayOneLine: all amounts will be displayed as if displayOneLine
+-- were False.
+showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder]
+showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =
+    map (adBuilder . pad) elided
+  where
+    Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma
+
+    astrs = amtDisplayList (wbWidth sep) (showAmountB opts) amts
+    sep   = WideBuilder (TB.singleton '\n') 0
+    width = maximum $ fromMaybe 0 mmin : map (wbWidth . adBuilder) elided
+
+    pad amt = amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt }
+      where w = width - wbWidth (adBuilder amt)
 
     elided = maybe id elideTo mmax astrs
     elideTo m xs = maybeAppend elisionStr short
       where
-        elisionStr = elisionDisplay (Just m) sepwidth (length long) $ lastDef nullAmountDisplay short
+        elisionStr = elisionDisplay (Just m) (wbWidth sep) (length long) $ lastDef nullAmountDisplay short
-        (short, long) = partition ((m>=) . adLength) xs
+        (short, long) = partition ((m>=) . wbWidth . adBuilder) xs
 
--- | General function to display a MixedAmount on a single line. It
+-- | Helper for showMixedAmountB to deal with single line displays. This does not
--- takes a function to display each Amount, an optional minimum width to
+-- honour displayOneLine: all amounts will be displayed as if displayOneLine
--- pad to, an optional maximum width to display, and a Bool to determine
+-- were True.
--- whether to colourise negative numbers. It will display as many Amounts
+showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> WideBuilder
--- as it can in the maximum width (if given), and further Amounts will be
+showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =
--- elided. The function also returns the actual width of the output string.
+    WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided) . max width $ fromMaybe 0 mmin
-showMixedOneLine :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)
-showMixedOneLine showamt mmin mmax c =
-    showMixedOneLineUnnormalised showamt mmin mmax c . normaliseMixedAmountSquashPricesForDisplay
-
--- | Like showMixedOneLine, but does not normalise the MixedAmount before
--- displaying.
-showMixedOneLineUnnormalised :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)
-showMixedOneLineUnnormalised showamt mmin mmax c (Mixed as) =
-    (pad . intercalate ", " $ map finalise elided, max width $ fromMaybe 0 mmin)
   where
-    width    = maybe 0 adTotal $ lastMay elided
+    Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma
-    astrs    = amtDisplayList sepwidth showamt as
-    sepwidth = 2  -- ", " has width 2
-    n        = length as
 
-    finalise = adString . if c then colourise else id
+    width  = maybe 0 adTotal $ lastMay elided
-    pad = applyN (fromMaybe 0 mmin - width) (' ':)
+    astrs  = amtDisplayList (wbWidth sep) (showAmountB opts) amts
+    sep    = WideBuilder (TB.fromString ", ") 2
+    n      = length amts
+
+    pad = (WideBuilder (TB.fromText $ T.replicate w " ") w <>)
+      where w = fromMaybe 0 mmin - width
 
     elided = maybe id elideTo mmax astrs
     elideTo m = addElide . takeFitting m . withElided
@@ -728,39 +798,36 @@ showMixedOneLineUnnormalised showamt mmin mmax c (Mixed as) =
     dropWhileRev p = foldr (\x xs -> if null xs && p x then [] else x:xs) []
 
     -- Add the elision strings (if any) to each amount
-    withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing sepwidth num amt)) [n-1,n-2..0]
+    withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (wbWidth sep) num amt)) [n-1,n-2..0]
 
 data AmountDisplay = AmountDisplay
-  { adAmount :: !Amount  -- ^ Amount displayed
+  { adBuilder :: !WideBuilder  -- ^ String representation of the Amount
-  , adString :: !String  -- ^ String representation of the Amount
+  , adTotal   :: !Int            -- ^ Cumulative length of MixedAmount this Amount is part of,
-  , adLength :: !Int     -- ^ Length of the string representation
+                                --   including separators
-  , adTotal  :: !Int     -- ^ Cumulative length of MixedAmount this Amount is part of,
+  }
-                         --   including separators
-  } deriving (Show)
 
 nullAmountDisplay :: AmountDisplay
-nullAmountDisplay = AmountDisplay nullamt "" 0 0
+nullAmountDisplay = AmountDisplay mempty 0
 
-amtDisplayList :: Int -> (Amount -> String) -> [Amount] -> [AmountDisplay]
+amtDisplayList :: Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay]
 amtDisplayList sep showamt = snd . mapAccumL display (-sep)
   where
-    display tot amt = (tot', AmountDisplay amt str width tot')
+    display tot amt = (tot', AmountDisplay str tot')
       where
         str  = showamt amt
-        width  = strWidth str
+        tot' = tot + (wbWidth str) + sep
-        tot' = tot + width + sep
 
 -- The string "m more", added to the previous running total
 elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
 elisionDisplay mmax sep n lastAmt
-  | n > 0     = Just $ AmountDisplay 0 str len (adTotal lastAmt + len)
+  | n > 0     = Just $ AmountDisplay (WideBuilder (TB.fromText str) len) (adTotal lastAmt + len)
   | otherwise = Nothing
   where
-    fullString = show n ++ " more.."
+    fullString = T.pack $ show n ++ " more.."
     -- sep from the separator, 7 from " more..", 1 + floor (logBase 10 n) from number
     fullLength = sep + 8 + floor (logBase 10 $ fromIntegral n)
 
-    str | Just m <- mmax, fullLength > m = take (m - 2) fullString ++ ".."
+    str | Just m <- mmax, fullLength > m = T.take (m - 2) fullString <> ".."
         | otherwise                      = fullString
     len = case mmax of Nothing -> fullLength
                        Just m  -> max 2 $ min m fullLength
@@ -769,10 +836,6 @@ maybeAppend :: Maybe a -> [a] -> [a]
 maybeAppend Nothing  = id
 maybeAppend (Just a) = (++[a])
 
-colourise :: AmountDisplay -> AmountDisplay
-colourise amt = amt{adString=markColour $ adString amt}
-  where markColour = if isNegativeAmount (adAmount amt) then color Dull Red else id
-
 -- | Compact labelled trace of a mixed amount, for debugging.
 ltraceamount :: String -> MixedAmount -> MixedAmount
 ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)

hledger-lib/Hledger/Data/Dates.hs

@@ -110,19 +110,19 @@ import Hledger.Utils
 
 -- Help ppShow parse and line-wrap DateSpans better in debug output.
 instance Show DateSpan where
-    show s = "DateSpan " ++ showDateSpan s
+    show s = "DateSpan " ++ T.unpack (showDateSpan s)
 
-showDate :: Day -> String
+showDate :: Day -> Text
-showDate = show
+showDate = T.pack . show
 
 -- | Render a datespan as a display string, abbreviating into a
 -- compact form if possible.
-showDateSpan :: DateSpan -> String
+showDateSpan :: DateSpan -> Text
 showDateSpan = showPeriod . dateSpanAsPeriod
 
 -- | Like showDateSpan, but show month spans as just the abbreviated month name
 -- in the current locale.
-showDateSpanMonthAbbrev :: DateSpan -> String
+showDateSpanMonthAbbrev :: DateSpan -> Text
 showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod
 
 -- | Get the current local date.
@@ -388,13 +388,13 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
 
 -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using
 -- the provided reference date, or raise an error.
-fixSmartDateStr :: Day -> Text -> String
+fixSmartDateStr :: Day -> Text -> Text
 fixSmartDateStr d s =
   either (error' . printf "could not parse date %s %s" (show s) . show) id $  -- PARTIAL:
-  (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String)
+  (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) Text)
 
 -- | A safe version of fixSmartDateStr.
-fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String
+fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Text
 fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d
 
 fixSmartDateStrEither'

hledger-lib/Hledger/Data/Journal.hs

@@ -87,20 +87,20 @@ module Hledger.Data.Journal (
   tests_Journal,
 )
 where
-import Control.Monad
+
-import Control.Monad.Except
+import Control.Monad.Except (ExceptT(..), runExceptT, throwError)
-import Control.Monad.Extra
+import Control.Monad.Extra (whenM)
 import Control.Monad.Reader as R
-import Control.Monad.ST
+import Control.Monad.ST (ST, runST)
-import Data.Array.ST
+import Data.Array.ST (STArray, getElems, newListArray, writeArray)
 import Data.Default (Default(..))
 import Data.Function ((&))
 import qualified Data.HashTable.Class as H (toList)
 import qualified Data.HashTable.ST.Cuckoo as H
-import Data.List
+import Data.List (find, sortOn)
 import Data.List.Extra (groupSort, nubSort)
 import qualified Data.Map as M
-import Data.Maybe
+import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe)
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Semigroup (Semigroup(..))
 #endif
@@ -108,10 +108,10 @@ import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Safe (headMay, headDef)
-import Data.Time.Calendar
+import Data.Time.Calendar (Day, addDays, fromGregorian)
-import Data.Tree
+import Data.Tree (Tree, flatten)
 import System.Time (ClockTime(TOD))
-import Text.Printf
+import Text.Printf (printf)
 
 import Hledger.Utils
 import Hledger.Data.Types
@@ -895,7 +895,7 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
          Nothing -> "?" -- shouldn't happen
          Just t ->  printf "%s\ntransaction:\n%s"
                       (showGenericSourcePos pos)
-                      (chomp $ showTransaction t)
+                      (textChomp $ showTransaction t)
                       :: String
                       where
                         pos = baposition $ fromJust $ pbalanceassertion p
@@ -926,11 +926,11 @@ checkIllegalBalanceAssignmentB p = do
 checkBalanceAssignmentPostingDateB :: Posting -> Balancing s ()
 checkBalanceAssignmentPostingDateB p =
   when (hasBalanceAssignment p && isJust (pdate p)) $
-    throwError $ unlines $
+    throwError . T.unpack $ T.unlines
       ["postings which are balance assignments may not have a custom date."
       ,"Please write the posting amount explicitly, or remove the posting date:"
       ,""
-      ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p
+      ,maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p
       ]
 
 -- | Throw an error if this posting is trying to do a balance assignment and
@@ -940,16 +940,16 @@ checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
 checkBalanceAssignmentUnassignableAccountB p = do
   unassignable <- R.asks bsUnassignable
   when (hasBalanceAssignment p && paccount p `S.member` unassignable) $
-    throwError $ unlines $
+    throwError . T.unpack $ T.unlines
       ["balance assignments cannot be used with accounts which are"
       ,"posted to by transaction modifier rules (auto postings)."
       ,"Please write the posting amount explicitly, or remove the rule."
       ,""
-      ,"account: "++T.unpack (paccount p)
+      ,"account: " <> paccount p
       ,""
       ,"transaction:"
       ,""
-      ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p
+      ,maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p
       ]
 
 --

hledger-lib/Hledger/Data/Json.hs

@@ -44,7 +44,7 @@ import           Data.Decimal
 import           Data.Maybe
 import qualified Data.Text.Lazy    as TL
 import qualified Data.Text.Lazy.IO as TL
-import           Data.Text.Lazy.Builder (toLazyText)
+import qualified Data.Text.Lazy.Builder as TB
 import           GHC.Generics (Generic)
 import           System.Time (ClockTime)
 
@@ -232,7 +232,7 @@ instance FromJSON (DecimalRaw Integer)
 
 -- | Show a JSON-convertible haskell value as pretty-printed JSON text.
 toJsonText :: ToJSON a => a -> TL.Text
-toJsonText = (<>"\n") . toLazyText . encodePrettyToTextBuilder
+toJsonText = TB.toLazyText . (<> TB.fromText "\n") . encodePrettyToTextBuilder
 
 -- | Write a JSON-convertible haskell value to a pretty-printed JSON file.
 -- Eg: writeJsonFile "a.json" nulltransaction

hledger-lib/Hledger/Data/Period.hs

@@ -5,6 +5,8 @@ a richer abstraction than DateSpan. See also Types and Dates.
 
 -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Hledger.Data.Period (
    periodAsDateSpan
   ,dateSpanAsPeriod
@@ -30,6 +32,8 @@ module Hledger.Data.Period (
 )
 where
 
+import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time.Calendar
 import Data.Time.Calendar.MonthDay
 import Data.Time.Calendar.OrdinalDate
@@ -155,21 +159,23 @@ isStandardPeriod = isStandardPeriod' . simplifyPeriod
 --
 -- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25))
 -- "2016-07-25W30"
-showPeriod (DayPeriod b)       = formatTime defaultTimeLocale "%F" b              -- DATE
+showPeriod :: Period -> Text
-showPeriod (WeekPeriod b)      = formatTime defaultTimeLocale "%FW%V" b           -- STARTDATEWYEARWEEK
+showPeriod (DayPeriod b)       = T.pack $ formatTime defaultTimeLocale "%F" b              -- DATE
-showPeriod (MonthPeriod y m)   = printf "%04d-%02d" y m                           -- YYYY-MM
+showPeriod (WeekPeriod b)      = T.pack $ formatTime defaultTimeLocale "%FW%V" b           -- STARTDATEWYEARWEEK
-showPeriod (QuarterPeriod y q) = printf "%04dQ%d" y q                             -- YYYYQN
+showPeriod (MonthPeriod y m)   = T.pack $ printf "%04d-%02d" y m                           -- YYYY-MM
-showPeriod (YearPeriod y)      = printf "%04d" y                                  -- YYYY
+showPeriod (QuarterPeriod y q) = T.pack $ printf "%04dQ%d" y q                             -- YYYYQN
-showPeriod (PeriodBetween b e) = formatTime defaultTimeLocale "%F" b
+showPeriod (YearPeriod y)      = T.pack $ printf "%04d" y                                  -- YYYY
+showPeriod (PeriodBetween b e) = T.pack $ formatTime defaultTimeLocale "%F" b
                                  ++ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- STARTDATE..INCLUSIVEENDDATE
-showPeriod (PeriodFrom b)      = formatTime defaultTimeLocale "%F.." b                   -- STARTDATE..
+showPeriod (PeriodFrom b)      = T.pack $ formatTime defaultTimeLocale "%F.." b                   -- STARTDATE..
-showPeriod (PeriodTo e)        = formatTime defaultTimeLocale "..%F" (addDays (-1) e)    -- ..INCLUSIVEENDDATE
+showPeriod (PeriodTo e)        = T.pack $ formatTime defaultTimeLocale "..%F" (addDays (-1) e)    -- ..INCLUSIVEENDDATE
 showPeriod PeriodAll           = ".."
 
 -- | Like showPeriod, but if it's a month period show just
 -- the 3 letter month name abbreviation for the current locale.
+showPeriodMonthAbbrev :: Period -> Text
 showPeriodMonthAbbrev (MonthPeriod _ m)                           -- Jan
-  | m > 0 && m <= length monthnames = snd $ monthnames !! (m-1)
+  | m > 0 && m <= length monthnames = T.pack . snd $ monthnames !! (m-1)
   where monthnames = months defaultTimeLocale
 showPeriodMonthAbbrev p = showPeriod p
 

hledger-lib/Hledger/Data/PeriodicTransaction.hs

@@ -16,6 +16,7 @@ where
 import Data.Semigroup ((<>))
 #endif
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Text.Printf
 
 import Hledger.Data.Types
@@ -40,7 +41,7 @@ _ptgen str = do
   case checkPeriodicTransactionStartDate i s t of
     Just e  -> error' e  -- PARTIAL:
     Nothing ->
-      mapM_ (putStr . showTransaction) $
+      mapM_ (T.putStr . showTransaction) $
         runPeriodicTransaction
           nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
           nulldatespan
@@ -52,7 +53,7 @@ _ptgenspan str span = do
   case checkPeriodicTransactionStartDate i s t of
     Just e  -> error' e  -- PARTIAL:
     Nothing ->
-      mapM_ (putStr . showTransaction) $
+      mapM_ (T.putStr . showTransaction) $
         runPeriodicTransaction
           nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
           span

hledger-lib/Hledger/Data/Posting.hs

@@ -161,20 +161,20 @@ originalPosting p = fromMaybe p $ poriginal p
 -- XXX once rendered user output, but just for debugging now; clean up
 showPosting :: Posting -> String
 showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
-    unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, showComment (pcomment p)]]
+    unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, T.unpack . showComment $ pcomment p]]
     where
       ledger3ishlayout = False
       acctnamewidth = if ledger3ishlayout then 25 else 22
-      showaccountname = fitString (Just acctnamewidth) Nothing False False . bracket . T.unpack . elideAccountName width
+      showaccountname = T.unpack . fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width
       (bracket,width) = case t of
-                          BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2)
+                          BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2)
-                          VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2)
+                          VirtualPosting         -> (wrap "(" ")", acctnamewidth-2)
-                          _ -> (id,acctnamewidth)
+                          _                      -> (id,acctnamewidth)
-      showamount = fst . showMixed showAmount (Just 12) Nothing False
+      showamount = wbUnpack . showMixedAmountB noColour{displayMinWidth=Just 12}
 
 
-showComment :: Text -> String
+showComment :: Text -> Text
-showComment t = if T.null t then "" else "  ;" ++ T.unpack t
+showComment t = if T.null t then "" else "  ;" <> t
 
 isReal :: Posting -> Bool
 isReal p = ptype p == RegularPosting
@@ -274,9 +274,9 @@ accountNameWithoutPostingType a = case accountNamePostingType a of
                                     RegularPosting -> a
 
 accountNameWithPostingType :: PostingType -> AccountName -> AccountName
-accountNameWithPostingType BalancedVirtualPosting a = "["<>accountNameWithoutPostingType a<>"]"
+accountNameWithPostingType BalancedVirtualPosting = wrap "[" "]" . accountNameWithoutPostingType
-accountNameWithPostingType VirtualPosting a = "("<>accountNameWithoutPostingType a<>")"
+accountNameWithPostingType VirtualPosting         = wrap "(" ")" . accountNameWithoutPostingType
-accountNameWithPostingType RegularPosting a = accountNameWithoutPostingType a
+accountNameWithPostingType RegularPosting         = accountNameWithoutPostingType
 
 -- | Prefix one account name to another, preserving posting type
 -- indicators like concatAccountNames.

hledger-lib/Hledger/Data/StringFormat.hs

@@ -2,7 +2,10 @@
 -- hledger's report item fields. The formats are used by
 -- report-specific renderers like renderBalanceReportItem.
 
-{-# LANGUAGE FlexibleContexts, OverloadedStrings, TypeFamilies, PackageImports #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports    #-}
+{-# LANGUAGE TypeFamilies      #-}
 
 module Hledger.Data.StringFormat (
           parseStringFormat
@@ -10,7 +13,6 @@ module Hledger.Data.StringFormat (
         , StringFormat(..)
         , StringFormatComponent(..)
         , ReportItemField(..)
-        , overlineWidth
         , defaultBalanceLineFormat
         , tests_StringFormat
         ) where
@@ -21,22 +23,20 @@ import Numeric (readDec)
 import Data.Char (isPrint)
 import Data.Default (Default(..))
 import Data.Maybe (isJust)
--- import qualified Data.Text as T
+import Data.Text (Text)
+import qualified Data.Text as T
 import Text.Megaparsec
 import Text.Megaparsec.Char (char, digitChar, string)
 
-import Hledger.Utils.Parse (SimpleStringParser)
+import Hledger.Utils.Parse (SimpleTextParser)
-import Hledger.Utils.String (formatString)
+import Hledger.Utils.Text (formatText)
 import Hledger.Utils.Test
 
 -- | A format specification/template to use when rendering a report line item as text.
 --
--- A format is an optional width, along with a sequence of components;
+-- A format is a sequence of components; each is either a literal
--- each is either a literal string, or a hledger report item field with
+-- string, or a hledger report item field with specified width and
--- specified width and justification whose value will be interpolated
+-- justification whose value will be interpolated at render time.
--- at render time. The optional width determines the length of the
--- overline to draw above the totals row; if it is Nothing, then the
--- maximum width of all lines is used.
 --
 -- A component's value may be a multi-line string (or a
 -- multi-commodity amount), in which case the final string will be
@@ -47,13 +47,13 @@ import Hledger.Utils.Test
 -- mode, which provides a limited StringFormat renderer.
 --
 data StringFormat =
-    OneLine       (Maybe Int) [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated
+    OneLine       [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated
-  | TopAligned    (Maybe Int) [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height)
+  | TopAligned    [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height)
-  | BottomAligned (Maybe Int) [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded)
+  | BottomAligned [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded)
   deriving (Show, Eq)
 
 data StringFormatComponent =
-    FormatLiteral String        -- ^ Literal text to be rendered as-is
+    FormatLiteral Text          -- ^ Literal text to be rendered as-is
   | FormatField Bool
                 (Maybe Int)
                 (Maybe Int)
@@ -81,14 +81,9 @@ data ReportItemField =
 
 instance Default StringFormat where def = defaultBalanceLineFormat
 
-overlineWidth :: StringFormat -> Maybe Int
-overlineWidth (OneLine       w _) = w
-overlineWidth (TopAligned    w _) = w
-overlineWidth (BottomAligned w _) = w
-
 -- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)"
 defaultBalanceLineFormat :: StringFormat
-defaultBalanceLineFormat = BottomAligned (Just 20) [
+defaultBalanceLineFormat = BottomAligned [
       FormatField False (Just 20) Nothing TotalField
     , FormatLiteral "  "
     , FormatField True (Just 2) Nothing DepthSpacerField
@@ -102,37 +97,37 @@ defaultBalanceLineFormat = BottomAligned (Just 20) [
 ----------------------------------------------------------------------
 
 -- | Parse a string format specification, or return a parse error.
-parseStringFormat :: String -> Either String StringFormat
+parseStringFormat :: Text -> Either String StringFormat
 parseStringFormat input = case (runParser (stringformatp <* eof) "(unknown)") input of
     Left y -> Left $ show y
     Right x -> Right x
 
 defaultStringFormatStyle = BottomAligned
 
-stringformatp :: SimpleStringParser StringFormat
+stringformatp :: SimpleTextParser StringFormat
 stringformatp = do
   alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String))
   let constructor =
         case alignspec of
-          Just '^' -> TopAligned Nothing
+          Just '^' -> TopAligned
-          Just '_' -> BottomAligned Nothing
+          Just '_' -> BottomAligned
-          Just ',' -> OneLine Nothing
+          Just ',' -> OneLine
-          _        -> defaultStringFormatStyle Nothing
+          _        -> defaultStringFormatStyle
   constructor <$> many componentp
 
-componentp :: SimpleStringParser StringFormatComponent
+componentp :: SimpleTextParser StringFormatComponent
 componentp = formatliteralp <|> formatfieldp
 
-formatliteralp :: SimpleStringParser StringFormatComponent
+formatliteralp :: SimpleTextParser StringFormatComponent
 formatliteralp = do
-    s <- some c
+    s <- T.pack <$> some c
     return $ FormatLiteral s
     where
       isPrintableButNotPercentage x = isPrint x && x /= '%'
       c =     (satisfy isPrintableButNotPercentage <?> "printable character")
           <|> try (string "%%" >> return '%')
 
-formatfieldp :: SimpleStringParser StringFormatComponent
+formatfieldp :: SimpleTextParser StringFormatComponent
 formatfieldp = do
     char '%'
     leftJustified <- optional (char '-')
@@ -147,7 +142,7 @@ formatfieldp = do
         Just text -> Just m where ((m,_):_) = readDec text
         _ -> Nothing
 
-fieldp :: SimpleStringParser ReportItemField
+fieldp :: SimpleTextParser ReportItemField
 fieldp = do
         try (string "account" >> return AccountField)
     <|> try (string "depth_spacer" >> return DepthSpacerField)
@@ -161,8 +156,8 @@ fieldp = do
 formatStringTester fs value expected = actual @?= expected
   where
     actual = case fs of
-      FormatLiteral l                   -> formatString False Nothing Nothing l
+      FormatLiteral l                   -> formatText False Nothing Nothing l
-      FormatField leftJustify min max _ -> formatString leftJustify min max value
+      FormatField leftJustify min max _ -> formatText leftJustify min max value
 
 tests_StringFormat = tests "StringFormat" [
 
@@ -176,25 +171,25 @@ tests_StringFormat = tests "StringFormat" [
       formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description         "
       formatStringTester (FormatField True Nothing (Just 3) DescriptionField)    "description" "des"
 
-  ,let s `gives` expected = test s $ parseStringFormat s @?= Right expected
+  ,let s `gives` expected = test s $ parseStringFormat (T.pack s) @?= Right expected
    in tests "parseStringFormat" [
-      ""                           `gives` (defaultStringFormatStyle Nothing [])
+      ""                           `gives` (defaultStringFormatStyle [])
-    , "D"                          `gives` (defaultStringFormatStyle Nothing [FormatLiteral "D"])
+    , "D"                          `gives` (defaultStringFormatStyle [FormatLiteral "D"])
-    , "%(date)"                    `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing DescriptionField])
+    , "%(date)"                    `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField])
-    , "%(total)"                   `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing TotalField])
+    , "%(total)"                   `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField])
     -- TODO
     -- , "^%(total)"                  `gives` (TopAligned [FormatField False Nothing Nothing TotalField])
     -- , "_%(total)"                  `gives` (BottomAligned [FormatField False Nothing Nothing TotalField])
     -- , ",%(total)"                  `gives` (OneLine [FormatField False Nothing Nothing TotalField])
-    , "Hello %(date)!"             `gives` (defaultStringFormatStyle Nothing [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"])
+    , "Hello %(date)!"             `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"])
-    , "%-(date)"                   `gives` (defaultStringFormatStyle Nothing [FormatField True Nothing Nothing DescriptionField])
+    , "%-(date)"                   `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField])
-    , "%20(date)"                  `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing DescriptionField])
+    , "%20(date)"                  `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField])
-    , "%.10(date)"                 `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing (Just 10) DescriptionField])
+    , "%.10(date)"                 `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField])
-    , "%20.10(date)"               `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) (Just 10) DescriptionField])
+    , "%20.10(date)"               `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField])
-    , "%20(account) %.10(total)"   `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing AccountField
+    , "%20(account) %.10(total)"   `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField
-                                                                             ,FormatLiteral " "
+                                                                     ,FormatLiteral " "
-                                                                             ,FormatField False Nothing (Just 10) TotalField
+                                                                     ,FormatField False Nothing (Just 10) TotalField
-                                                                             ])
+                                                                     ])
     , test "newline not parsed" $ assertLeft $ parseStringFormat "\n"
     ]
  ]

hledger-lib/Hledger/Data/Timeclock.hs

@@ -6,6 +6,7 @@ converted to 'Transactions' and queried like a ledger.
 
 -}
 
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Hledger.Data.Timeclock (
@@ -14,14 +15,18 @@ module Hledger.Data.Timeclock (
 )
 where
 
-import Data.Maybe
+import Data.Maybe (fromMaybe)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
 -- import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Time.Calendar
+import Data.Time.Calendar (addDays)
-import Data.Time.Clock
+import Data.Time.Clock (addUTCTime, getCurrentTime)
-import Data.Time.Format
+import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
-import Data.Time.LocalTime
+import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), getCurrentTimeZone,
-import Text.Printf
+                            localTimeToUTC, midnight, utc, utcToLocalTime)
+import Text.Printf (printf)
 
 import Hledger.Utils
 import Hledger.Data.Types
@@ -90,8 +95,8 @@ errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg
 entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction
 entryFromTimeclockInOut i o
     | otime >= itime = t
-    | otherwise =
+    | otherwise = error' . T.unpack $
-        error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t  -- PARTIAL:
+        "clock-out time less than clock-in time in:\n" <> showTransaction t  -- PARTIAL:
     where
       t = Transaction {
             tindex       = 0,

hledger-lib/Hledger/Data/Transaction.hs

@@ -7,11 +7,12 @@ tags.
 
 -}
 
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE CPP               #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE Rank2Types        #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards   #-}
 
 module Hledger.Data.Transaction (
   -- * Transaction
@@ -44,8 +45,6 @@ module Hledger.Data.Transaction (
   -- * rendering
   showTransaction,
   showTransactionOneLineAmounts,
-  showTransactionUnelided,
-  showTransactionUnelidedOneLineAmounts,
   -- showPostingLine,
   showPostingLines,
   -- * GenericSourcePos
@@ -57,13 +56,19 @@ module Hledger.Data.Transaction (
   tests_Transaction
 )
 where
-import Data.List
+
+import Data.Default (def)
+import Data.List (intercalate, partition)
 import Data.List.Extra (nubSort)
-import Data.Maybe
+import Data.Maybe (fromMaybe, mapMaybe)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Time.Calendar
+import qualified Data.Text.Lazy as TL
-import Text.Printf
+import qualified Data.Text.Lazy.Builder as TB
+import Data.Time.Calendar (Day, fromGregorian)
 import qualified Data.Map as M
 
 import Hledger.Utils
@@ -72,6 +77,8 @@ import Hledger.Data.Dates
 import Hledger.Data.Posting
 import Hledger.Data.Amount
 import Hledger.Data.Valuation
+import Text.Tabular
+import Text.Tabular.AsciiWide
 
 sourceFilePath :: GenericSourcePos -> FilePath
 sourceFilePath = \case
@@ -148,53 +155,46 @@ To facilitate this, postings with explicit multi-commodity amounts
 are displayed as multiple similar postings, one per commodity.
 (Normally does not happen with this function).
 -}
-showTransaction :: Transaction -> String
+showTransaction :: Transaction -> Text
-showTransaction = showTransactionHelper False
+showTransaction = TL.toStrict . TB.toLazyText . showTransactionHelper False
-
--- | Deprecated alias for 'showTransaction'
-showTransactionUnelided :: Transaction -> String
-showTransactionUnelided = showTransaction  -- TODO: drop it
 
 -- | Like showTransaction, but explicit multi-commodity amounts
 -- are shown on one line, comma-separated. In this case the output will
 -- not be parseable journal syntax.
-showTransactionOneLineAmounts :: Transaction -> String
+showTransactionOneLineAmounts :: Transaction -> Text
-showTransactionOneLineAmounts = showTransactionHelper True
+showTransactionOneLineAmounts = TL.toStrict . TB.toLazyText . showTransactionHelper True
-
--- | Deprecated alias for 'showTransactionOneLineAmounts'
-showTransactionUnelidedOneLineAmounts :: Transaction -> String
-showTransactionUnelidedOneLineAmounts = showTransactionOneLineAmounts  -- TODO: drop it
 
 -- | Helper for showTransaction*.
-showTransactionHelper :: Bool -> Transaction -> String
+showTransactionHelper :: Bool -> Transaction -> TB.Builder
 showTransactionHelper onelineamounts t =
-    unlines $ [descriptionline]
+      TB.fromText descriptionline <> newline
-              ++ newlinecomments
+    <> foldMap ((<> newline) . TB.fromText) newlinecomments
-              ++ (postingsAsLines onelineamounts (tpostings t))
+    <> foldMap ((<> newline) . TB.fromText) (postingsAsLines onelineamounts $ tpostings t)
-              ++ [""]
+    <> newline
-    where
+  where
-      descriptionline = rstrip $ concat [date, status, code, desc, samelinecomment]
+    descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment]
-      date = showDate (tdate t) ++ maybe "" (("="++) . showDate) (tdate2 t)
+    date = showDate (tdate t) <> maybe "" (("="<>) . showDate) (tdate2 t)
-      status | tstatus t == Cleared = " *"
+    status | tstatus t == Cleared = " *"
-             | tstatus t == Pending = " !"
+           | tstatus t == Pending = " !"
-             | otherwise            = ""
+           | otherwise            = ""
-      code = if T.length (tcode t) > 0 then printf " (%s)" $ T.unpack $ tcode t else ""
+    code = if T.null (tcode t) then "" else wrap " (" ")" $ tcode t
-      desc = if null d then "" else " " ++ d where d = T.unpack $ tdescription t
+    desc = if T.null d then "" else " " <> d where d = tdescription t
-      (samelinecomment, newlinecomments) =
+    (samelinecomment, newlinecomments) =
-        case renderCommentLines (tcomment t) of []   -> ("",[])
+      case renderCommentLines (tcomment t) of []   -> ("",[])
-                                                c:cs -> (c,cs)
+                                              c:cs -> (c,cs)
+    newline = TB.singleton '\n'
 
 -- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines.
 -- The first line (unless empty) will have leading space, subsequent lines will have a larger indent.
-renderCommentLines :: Text -> [String]
+renderCommentLines :: Text -> [Text]
 renderCommentLines t =
-  case lines $ T.unpack t of
+  case T.lines t of
     []      -> []
-    [l]     -> [(commentSpace . comment) l]        -- single-line comment
+    [l]     -> [commentSpace $ comment l]        -- single-line comment
     ("":ls) -> "" : map (lineIndent . comment) ls  -- multi-line comment with empty first line
-    (l:ls)  -> (commentSpace . comment) l : map (lineIndent . comment) ls
+    (l:ls)  -> commentSpace (comment l) : map (lineIndent . comment) ls
   where
-    comment = ("; "++)
+    comment = ("; "<>)
 
 -- | Given a transaction and its postings, render the postings, suitable
 -- for `print` output. Normally this output will be valid journal syntax which
@@ -214,7 +214,7 @@ renderCommentLines t =
 -- Posting amounts will be aligned with each other, starting about 4 columns
 -- beyond the widest account name (see postingAsLines for details).
 --
-postingsAsLines :: Bool -> [Posting] -> [String]
+postingsAsLines :: Bool -> [Posting] -> [Text]
 postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamounts ps) ps
 
 -- | Render one posting, on one or more lines, suitable for `print` output.
@@ -236,41 +236,55 @@ postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamoun
 -- increased if needed to match the posting with the longest account name.
 -- This is used to align the amounts of a transaction's postings.
 --
-postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [String]
+postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [Text]
-postingAsLines elideamount onelineamounts pstoalignwith p = concat [
+postingAsLines elideamount onelineamounts pstoalignwith p =
-    postingblock
+    concatMap (++ newlinecomments) postingblocks
-    ++ newlinecomments
-    | postingblock <- postingblocks]
   where
-    postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, "  ", amt, assertion, samelinecomment] | amt <- shownAmounts]
+    -- This needs to be converted to strict Text in order to strip trailing
-    assertion = maybe "" ((' ':).showBalanceAssertion) $ pbalanceassertion p
+    -- spaces. This adds a small amount of inefficiency, and the only difference
-    statusandaccount = lineIndent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p
+    -- is whether there are trailing spaces in print (and related) reports. This
-        where
+    -- could be removed and we could just keep everything as a Text Builder, but
-          -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned
+    -- would require adding trailing spaces to 42 failing tests.
-          minwidth = maximum $ map ((2+) . textWidth . T.pack . pacctstr) pstoalignwith
+    postingblocks = [map T.stripEnd . T.lines . TL.toStrict $
-          pstatusandacct p' = pstatusprefix p' ++ pacctstr p'
+                       render [ alignCell BottomLeft statusandaccount
-          pstatusprefix p' | null s    = ""
+                              , alignCell BottomLeft "  "
-                           | otherwise = s ++ " "
+                              , Cell BottomLeft [amt]
-            where s = show $ pstatus p'
+                              , Cell BottomLeft [assertion]
-          pacctstr p' = showAccountName Nothing (ptype p') (paccount p')
+                              , alignCell BottomLeft samelinecomment
+                              ]
+                    | amt <- shownAmounts]
+    render = renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map Header
+    assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p
+    statusandaccount = lineIndent . fitText (Just $ minwidth) Nothing False True $ pstatusandacct p
+      where
+        -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned
+        minwidth = maximum $ map ((2+) . textWidth . pacctstr) pstoalignwith
+        pstatusandacct p' = pstatusprefix p' <> pacctstr p'
+        pstatusprefix p' = case pstatus p' of
+            Unmarked -> ""
+            s        -> T.pack (show s) <> " "
+        pacctstr p' = showAccountName Nothing (ptype p') (paccount p')
 
     -- currently prices are considered part of the amount string when right-aligning amounts
     shownAmounts
-      | elideamount    = [""]
+      | elideamount || null (amounts $ pamount p) = [mempty]
-      | onelineamounts = [fst . showMixedOneLineUnnormalised showAmount (Just amtwidth) Nothing False $ pamount p]
+      | otherwise = showMixedAmountLinesB displayopts $ pamount p
-      | null (amounts $ pamount p) = [""]
-      | otherwise      = lines . fst . showMixedUnnormalised showAmount (Just amtwidth) Nothing False $ pamount p
       where
-        amtwidth = maximum $ 12 : map (snd . showMixedUnnormalised showAmount Nothing Nothing False . pamount) pstoalignwith  -- min. 12 for backwards compatibility
+        displayopts = noColour{displayOneLine=onelineamounts, displayMinWidth = Just amtwidth, displayNormalised=False}
+        amtwidth = maximum $ 12 : map (wbWidth . showMixedAmountB displayopts{displayMinWidth=Nothing} . pamount) pstoalignwith  -- min. 12 for backwards compatibility
 
     (samelinecomment, newlinecomments) =
       case renderCommentLines (pcomment p) of []   -> ("",[])
                                               c:cs -> (c,cs)
 
 -- | Render a balance assertion, as the =[=][*] symbol and expected amount.
-showBalanceAssertion :: BalanceAssertion -> [Char]
+showBalanceAssertion :: BalanceAssertion -> WideBuilder
 showBalanceAssertion BalanceAssertion{..} =
-  "=" ++ ['=' | batotal] ++ ['*' | bainclusive] ++ " " ++ showAmountWithZeroCommodity baamount
+    singleton '=' <> eq <> ast <> singleton ' ' <> showAmountB def{displayZeroCommodity=True} baamount
+  where
+    eq  = if batotal     then singleton '=' else mempty
+    ast = if bainclusive then singleton '*' else mempty
+    singleton c = WideBuilder (TB.singleton c) 1
 
 -- | Render a posting, simply. Used in balance assertion errors.
 -- showPostingLine p =
@@ -286,33 +300,27 @@ showBalanceAssertion BalanceAssertion{..} =
 
 -- | Render a posting, at the appropriate width for aligning with
 -- its siblings if any. Used by the rewrite command.
-showPostingLines :: Posting -> [String]
+showPostingLines :: Posting -> [Text]
 showPostingLines p = postingAsLines False False ps p where
     ps | Just t <- ptransaction p = tpostings t
        | otherwise = [p]
 
 -- | Prepend a suitable indent for a posting (or transaction/posting comment) line.
-lineIndent :: String -> String
+lineIndent :: Text -> Text
-lineIndent = ("    "++)
+lineIndent = ("    "<>)
 
 -- | Prepend the space required before a same-line comment.
-commentSpace :: String -> String
+commentSpace :: Text -> Text
-commentSpace = ("  "++)
+commentSpace = ("  "<>)
 
 -- | Show an account name, clipped to the given width if any, and
 -- appropriately bracketed/parenthesised for the given posting type.
-showAccountName :: Maybe Int -> PostingType -> AccountName -> String
+showAccountName :: Maybe Int -> PostingType -> AccountName -> Text
 showAccountName w = fmt
   where
-    fmt RegularPosting = maybe id take w . T.unpack
+    fmt RegularPosting         = maybe id T.take w
-    fmt VirtualPosting = parenthesise . maybe id (takeEnd . subtract 2) w . T.unpack
+    fmt VirtualPosting         = wrap "(" ")" . maybe id (T.takeEnd . subtract 2) w
-    fmt BalancedVirtualPosting = bracket . maybe id (takeEnd . subtract 2) w . T.unpack
+    fmt BalancedVirtualPosting = wrap "[" "]" . maybe id (T.takeEnd . subtract 2) w
-
-parenthesise :: String -> String
-parenthesise s = "("++s++")"
-
-bracket :: String -> String
-bracket s = "["++s++"]"
 
 hasRealPostings :: Transaction -> Bool
 hasRealPostings = not . null . realPostings
@@ -427,7 +435,9 @@ transactionBalanceError t errs =
 
 annotateErrorWithTransaction :: Transaction -> String -> String
 annotateErrorWithTransaction t s =
-  unlines [showGenericSourcePos $ tsourcepos t, s, rstrip $ showTransaction t]
+  unlines [ showGenericSourcePos $ tsourcepos t, s
+          , T.unpack . T.stripEnd $ showTransaction t
+          ]
 
 -- | Infer up to one missing amount for this transactions's real postings, and
 -- likewise for its balanced virtual postings, if needed; or return an error
@@ -678,7 +688,7 @@ tests_Transaction =
            Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]}
          (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?=
            Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]}
-         
+
     , tests "showTransaction" [
           test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n"
         , test "non-null transaction" $ showTransaction
@@ -701,7 +711,7 @@ tests_Transaction =
                       }
                   ]
               } @?=
-          unlines
+          T.unlines
             [ "2012-05-14=2012-05-15 (code) desc  ; tcomment1"
             , "    ; tcomment2"
             , "    * a         $1.00"
@@ -727,7 +737,7 @@ tests_Transaction =
                    , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t}
                    ]
             in showTransaction t) @?=
-          (unlines
+          (T.unlines
              [ "2007-01-28 coopportunity"
              , "    expenses:food:groceries          $47.18"
              , "    assets:checking                 $-47.18"
@@ -750,7 +760,7 @@ tests_Transaction =
                 [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]}
                 , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]}
                 ])) @?=
-          (unlines
+          (T.unlines
              [ "2007-01-28 coopportunity"
              , "    expenses:food:groceries          $47.18"
              , "    assets:checking                 $-47.19"
@@ -771,7 +781,7 @@ tests_Transaction =
                 ""
                 []
                 [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?=
-          (unlines ["2007-01-28 coopportunity", "    expenses:food:groceries", ""])
+          (T.unlines ["2007-01-28 coopportunity", "    expenses:food:groceries", ""])
         , test "show a transaction with a priced commodityless amount" $
           (showTransaction
              (txnTieKnot $
@@ -789,7 +799,7 @@ tests_Transaction =
                 [ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` Precision 0)]}
                 , posting {paccount = "b", pamount = missingmixedamt}
                 ])) @?=
-          (unlines ["2010-01-01 x", "    a          1 @ $2", "    b", ""])
+          (T.unlines ["2010-01-01 x", "    a          1 @ $2", "    b", ""])
         ]
     , tests "balanceTransaction" [
          test "detect unbalanced entry, sign error" $

hledger-lib/Hledger/Data/TransactionModifier.hs

@@ -26,7 +26,7 @@ import Hledger.Data.Amount
 import Hledger.Data.Transaction
 import Hledger.Query
 import Hledger.Data.Posting (commentJoin, commentAddTag)
-import Hledger.Utils.Debug
+import Hledger.Utils
 
 -- $setup
 -- >>> :set -XOverloadedStrings
@@ -62,7 +62,8 @@ modifyTransactions d tmods ts = do
 -- postings when certain other postings are present.
 --
 -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
--- >>> test = either putStr (putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate
+-- >>> import qualified Data.Text.IO as T
+-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate
 -- >>> test $ TransactionModifier "" ["pong" `post` usd 2]
 -- 0000-01-01
 --     ping           $1.00
@@ -137,7 +138,7 @@ postingRuleMultiplier p =
 renderPostingCommentDates :: Posting -> Posting
 renderPostingCommentDates p = p { pcomment = comment' }
     where
-        dates = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p]
+        dates = T.concat $ catMaybes [showDate <$> pdate p, ("=" <>) . showDate <$> pdate2 p]
         comment'
             | T.null dates = pcomment p
-            | otherwise    = ("[" <> dates <> "]") `commentJoin` pcomment p
+            | otherwise    = (wrap "[" "]" dates) `commentJoin` pcomment p

hledger-lib/Hledger/Query.hs

@@ -66,6 +66,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe)
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Monoid ((<>))
 #endif
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Calendar (Day, fromGregorian )
 import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay)
@@ -107,11 +108,11 @@ data Query = Any              -- ^ always match
 instance Default Query where def = Any
 
 -- | Construct a payee tag
-payeeTag :: Maybe String -> Either RegexError Query
+payeeTag :: Maybe Text -> Either RegexError Query
 payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI)
 
 -- | Construct a note tag
-noteTag :: Maybe String -> Either RegexError Query
+noteTag :: Maybe Text -> Either RegexError Query
 noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI)
 
 -- | Construct a generated-transaction tag
@@ -262,11 +263,11 @@ parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
     Right (Left m)  -> Right $ Left $ Not m
     Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored
     Left err        -> Left err
-parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI (T.unpack s)
+parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI s
-parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI (T.unpack s)
+parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI s
-parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just $ T.unpack s)
+parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just s)
-parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just $ T.unpack s)
+parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just s)
-parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI (T.unpack s)
+parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI s
 parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =
         case parsePeriodExpr d s of Left e         -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e
                                     Right (_,span) -> Right $ Left $ Date2 span
@@ -283,7 +284,7 @@ parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
   | otherwise = Left "depth: should have a positive number"
   where n = readDef 0 (T.unpack s)
 
-parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ('^' : T.unpack s ++ "$") -- support cur: as an alias
+parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias
 parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s
 parseQueryTerm _ "" = Right $ Left $ Any
 parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
@@ -322,20 +323,19 @@ parseAmountQueryTerm amtarg =
     (parse ">"   -> Just q) -> Right (AbsGt   ,q)
     (parse "="   -> Just q) -> Right (AbsEq   ,q)
     (parse ""    -> Just q) -> Right (AbsEq   ,q)
-    _ -> Left $
+    _ -> Left . T.unpack $
-         "could not parse as a comparison operator followed by an optionally-signed number: "
+         "could not parse as a comparison operator followed by an optionally-signed number: " <> amtarg
-         ++ T.unpack amtarg
   where
     -- Strip outer whitespace from the text, require and remove the
     -- specified prefix, remove all whitespace from the remainder, and
     -- read it as a simple integer or decimal if possible.
     parse :: T.Text -> T.Text -> Maybe Quantity
-    parse p s = (T.stripPrefix p . T.strip) s >>= readMay . filter (not.(==' ')) . T.unpack
+    parse p s = (T.stripPrefix p . T.strip) s >>= readMay . T.unpack . T.filter (/=' ')
 
 parseTag :: T.Text -> Either RegexError Query
 parseTag s = do
-    tag <- toRegexCI . T.unpack $ if T.null v then s else n
+    tag <- toRegexCI $ if T.null v then s else n
-    body <- if T.null v then pure Nothing else Just <$> toRegexCI (tail $ T.unpack v)
+    body <- if T.null v then pure Nothing else Just <$> toRegexCI (T.tail v)
     return $ Tag tag body
   where (n,v) = T.break (=='=') s
 
@@ -554,7 +554,7 @@ matchesAccount (None) _ = False
 matchesAccount (Not m) a = not $ matchesAccount m a
 matchesAccount (Or ms) a = any (`matchesAccount` a) ms
 matchesAccount (And ms) a = all (`matchesAccount` a) ms
-matchesAccount (Acct r) a = regexMatch r $ T.unpack a -- XXX pack
+matchesAccount (Acct r) a = regexMatchText r a
 matchesAccount (Depth d) a = accountNameLevel a <= d
 matchesAccount (Tag _ _) _ = False
 matchesAccount _ _ = True
@@ -564,7 +564,7 @@ matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt
 matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as
 
 matchesCommodity :: Query -> CommoditySymbol -> Bool
-matchesCommodity (Sym r) = regexMatch r . T.unpack
+matchesCommodity (Sym r) = regexMatchText r
 matchesCommodity _ = const True
 
 -- | Does the match expression match this (simple) amount ?
@@ -603,10 +603,10 @@ matchesPosting (Any) _ = True
 matchesPosting (None) _ = False
 matchesPosting (Or qs) p = any (`matchesPosting` p) qs
 matchesPosting (And qs) p = all (`matchesPosting` p) qs
-matchesPosting (Code r) p = regexMatch r $ maybe "" (T.unpack . tcode) $ ptransaction p
+matchesPosting (Code r) p = maybe False (regexMatchText r . tcode) $ ptransaction p
-matchesPosting (Desc r) p = regexMatch r $ maybe "" (T.unpack . tdescription) $ ptransaction p
+matchesPosting (Desc r) p = maybe False (regexMatchText r . tdescription) $ ptransaction p
 matchesPosting (Acct r) p = matches p || matches (originalPosting p)
-  where matches p = regexMatch r . T.unpack $ paccount p -- XXX pack
+  where matches = regexMatchText r . paccount
 matchesPosting (Date span) p = span `spanContainsDate` postingDate p
 matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p
 matchesPosting (StatusQ s) p = postingStatus p == s
@@ -615,8 +615,8 @@ matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a
 matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
 matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as
 matchesPosting (Tag n v) p = case (reString n, v) of
-  ("payee", Just v) -> maybe False (regexMatch v . T.unpack . transactionPayee) $ ptransaction p
+  ("payee", Just v) -> maybe False (regexMatchText v . transactionPayee) $ ptransaction p
-  ("note", Just v) -> maybe False (regexMatch v . T.unpack . transactionNote) $ ptransaction p
+  ("note", Just v) -> maybe False (regexMatchText v . transactionNote) $ ptransaction p
   (_, v) -> matchesTags n v $ postingAllTags p
 
 -- | Does the match expression match this transaction ?
@@ -626,8 +626,8 @@ matchesTransaction (Any) _ = True
 matchesTransaction (None) _ = False
 matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs
 matchesTransaction (And qs) t = all (`matchesTransaction` t) qs
-matchesTransaction (Code r) t = regexMatch r $ T.unpack $ tcode t
+matchesTransaction (Code r) t = regexMatchText r $ tcode t
-matchesTransaction (Desc r) t = regexMatch r $ T.unpack $ tdescription t
+matchesTransaction (Desc r) t = regexMatchText r $ tdescription t
 matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t
 matchesTransaction (Date span) t = spanContainsDate span $ tdate t
 matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t
@@ -637,15 +637,15 @@ matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t
 matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t
 matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t
 matchesTransaction (Tag n v) t = case (reString n, v) of
-  ("payee", Just v) -> regexMatch v . T.unpack . transactionPayee $ t
+  ("payee", Just v) -> regexMatchText v $ transactionPayee t
-  ("note", Just v) -> regexMatch v . T.unpack . transactionNote $ t
+  ("note", Just v) -> regexMatchText v $ transactionNote t
   (_, v) -> matchesTags n v $ transactionAllTags t
 
 -- | Does the query match the name and optionally the value of any of these tags ?
 matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
 matchesTags namepat valuepat = not . null . filter (matches namepat valuepat)
   where
-    matches npat vpat (n,v) = regexMatch npat (T.unpack n) && maybe (const True) regexMatch vpat (T.unpack v)
+    matches npat vpat (n,v) = regexMatchText npat n && maybe (const True) regexMatchText vpat v
 
 -- | Does the query match this market price ?
 matchesPriceDirective :: Query -> PriceDirective -> Bool

hledger-lib/Hledger/Read.hs

@@ -11,8 +11,9 @@ to import modules below this one.
 -}
 
 --- ** language
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE PackageImports      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 --- ** exports
@@ -53,9 +54,13 @@ import Data.List (group, sort, sortBy)
 import Data.List.NonEmpty (nonEmpty)
 import Data.Maybe (fromMaybe)
 import Data.Ord (comparing)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
 import Data.Semigroup (sconcat)
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Data.Time (Day)
 import Safe (headDef)
 import System.Directory (doesFileExist, getHomeDirectory)
@@ -63,8 +68,7 @@ import System.Environment (getEnv)
 import System.Exit (exitFailure)
 import System.FilePath ((<.>), (</>), splitDirectories, splitFileName)
 import System.Info (os)
-import System.IO (stderr, writeFile)
+import System.IO (hPutStr, stderr)
-import Text.Printf (hPrintf, printf)
 
 import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate)
 import Hledger.Data.Types
@@ -191,9 +195,9 @@ requireJournalFileExists "-" = return ()
 requireJournalFileExists f = do
   exists <- doesFileExist f
   when (not exists) $ do  -- XXX might not be a journal file
-    hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f
+    hPutStr stderr $ "The hledger journal file \"" <> show f <> "\" was not found.\n"
-    hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"
+    hPutStr stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"
-    hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"
+    hPutStr stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"
     exitFailure
 
 -- | Ensure there is a journal file at the given path, creating an empty one if needed.
@@ -202,14 +206,14 @@ requireJournalFileExists f = do
 ensureJournalFileExists :: FilePath -> IO ()
 ensureJournalFileExists f = do
   when (os/="mingw32" && isWindowsUnsafeDotPath f) $ do
-    hPrintf stderr "Part of file path %s\n ends with a dot, which is unsafe on Windows; please use a different path.\n" (show f)
+    hPutStr stderr $ "Part of file path \"" <> show f <> "\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n"
     exitFailure
   exists <- doesFileExist f
   when (not exists) $ do
-    hPrintf stderr "Creating hledger journal file %s.\n" f
+    hPutStr stderr $ "Creating hledger journal file " <> show f <> ".\n"
     -- note Hledger.Utils.UTF8.* do no line ending conversion on windows,
     -- we currently require unix line endings on all platforms.
-    newJournalContent >>= writeFile f
+    newJournalContent >>= T.writeFile f
 
 -- | Does any part of this path contain non-. characters and end with a . ?
 -- Such paths are not safe to use on Windows (cf #1056).
@@ -221,10 +225,10 @@ isWindowsUnsafeDotPath =
   splitDirectories
 
 -- | Give the content for a new auto-created journal file.
-newJournalContent :: IO String
+newJournalContent :: IO Text
 newJournalContent = do
   d <- getCurrentDay
-  return $ printf "; journal created %s by hledger\n" (show d)
+  return $ "; journal created " <> T.pack (show d) <> " by hledger\n"
 
 -- A "LatestDates" is zero or more copies of the same date,
 -- representing the latest transaction date read from a file,
@@ -240,7 +244,7 @@ latestDates = headDef [] . take 1 . group . reverse . sort
 -- | Remember that these transaction dates were the latest seen when
 -- reading this journal file.
 saveLatestDates :: LatestDates -> FilePath -> IO ()
-saveLatestDates dates f = writeFile (latestDatesFileFor f) $ unlines $ map showDate dates
+saveLatestDates dates f = T.writeFile (latestDatesFileFor f) $ T.unlines $ map showDate dates
 
 -- | What were the latest transaction dates seen the last time this
 -- journal file was read ? If there were multiple transactions on the

hledger-lib/Hledger/Read/Common.hs

@@ -379,11 +379,11 @@ journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j
   where
     checkpayee t
       | p `elem` ps = Right ()
-      | otherwise = Left $ 
+      | otherwise = Left $
           printf "undeclared payee \"%s\"\nat: %s\n\n%s"
-            (T.unpack p) 
+            (T.unpack p)
             (showGenericSourcePos $ tsourcepos t)
-            (linesPrepend2 "> " "  " $ chomp1 $ showTransaction t)
+            (linesPrepend2 "> " "  " . (<>"\n") . textChomp $ showTransaction t)
       where
         p  = transactionPayee t
         ps = journalPayeesDeclared j
@@ -397,11 +397,11 @@ journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j
       | paccount `elem` as = Right ()
       | otherwise = Left $
           (printf "undeclared account \"%s\"\n" (T.unpack paccount))
-          ++ case ptransaction of 
+          ++ case ptransaction of
               Nothing -> ""
               Just t  -> printf "in transaction at: %s\n\n%s"
                           (showGenericSourcePos $ tsourcepos t)
-                          (linesPrepend "  " $ chomp1 $ showTransaction t)
+                          (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)
       where
         as = journalAccountNamesDeclared j
 
@@ -416,13 +416,13 @@ journalCheckCommoditiesDeclared j =
         Nothing -> Right ()
         Just c  -> Left $
           (printf "undeclared commodity \"%s\"\n" (T.unpack c))
-          ++ case ptransaction of 
+          ++ case ptransaction of
               Nothing -> ""
               Just t  -> printf "in transaction at: %s\n\n%s"
                           (showGenericSourcePos $ tsourcepos t)
-                          (linesPrepend "  " $ chomp1 $ showTransaction t)
+                          (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)
       where
-        mfirstundeclaredcomm = 
+        mfirstundeclaredcomm =
           headMay $ filter (not . (`elem` cs)) $ catMaybes $
           (acommodity . baamount <$> pbalanceassertion) :
           (map (Just . acommodity) . filter (/= missingamt) $ amounts pamount)
@@ -1144,7 +1144,7 @@ digitgroupp :: TextParser m DigitGrp
 digitgroupp = label "digits"
             $ makeGroup <$> takeWhile1P (Just "digit") isDigit
   where
-    makeGroup = uncurry DigitGrp . foldl' step (0, 0) . T.unpack
+    makeGroup = uncurry DigitGrp . T.foldl' step (0, 0)
     step (!l, !a) c = (l+1, a*10 + fromIntegral (digitToInt c))
 
 --- *** comments
@@ -1483,7 +1483,7 @@ regexaliasp = do
   char '='
   skipNonNewlineSpaces
   repl <- anySingle `manyTill` eolof
-  case toRegexCI re of
+  case toRegexCI $ T.pack re of
     Right r -> return $! RegexAlias r repl
     Left e  -> customFailure $! parseErrorAtRegion off1 off2 e
 

hledger-lib/Hledger/Read/CsvReader.hs

@@ -11,17 +11,17 @@ A reader for CSV data, using an extra rules file to help interpret the data.
 -- stack haddock hledger-lib --fast --no-haddock-deps --haddock-arguments='--ignore-all-exports' --open
 
 --- ** language
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts     #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE MultiWayIf           #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NamedFieldPuns       #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PackageImports       #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards      #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns         #-}
 
 --- ** exports
 module Hledger.Read.CsvReader (
@@ -52,7 +52,6 @@ import Control.Monad.Trans.Class  (lift)
 import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord)
 import Data.Bifunctor             (first)
 import "base-compat-batteries" Data.List.Compat
-import qualified Data.List.Split as LS (splitOn)
 import Data.Maybe (catMaybes, fromMaybe, isJust)
 import Data.MemoUgly (memo)
 import Data.Ord (comparing)
@@ -61,6 +60,8 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
 import Data.Time.Calendar (Day)
 import Data.Time.Format (parseTimeM, defaultTimeLocale)
 import Safe (atMay, headMay, lastMay, readDef, readMay)
@@ -88,7 +89,7 @@ import Hledger.Read.Common (aliasesFromOpts,  Reader(..),InputOpts(..), amountp,
 
 type CSV       = [CsvRecord]
 type CsvRecord = [CsvValue]
-type CsvValue  = String
+type CsvValue  = Text
 
 --- ** reader
 
@@ -164,7 +165,7 @@ defaultRulesText csvfile = T.pack $ unlines
   ," account2 assets:bank:savings\n"
   ]
 
-addDirective :: (DirectiveName, String) -> CsvRulesParsed -> CsvRulesParsed
+addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed
 addDirective d r = r{rdirectives=d:rdirectives r}
 
 addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
@@ -181,7 +182,7 @@ addAssignmentsFromList fs r = foldl' maybeAddAssignment r journalfieldnames
   where
     maybeAddAssignment rules f = (maybe id addAssignmentFromIndex $ elemIndex f fs) rules
       where
-        addAssignmentFromIndex i = addAssignment (f, "%"++show (i+1))
+        addAssignmentFromIndex i = addAssignment (f, T.pack $ '%':show (i+1))
 
 addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
 addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r}
@@ -205,7 +206,7 @@ expandIncludes dir content = mapM (expandLine dir) (T.lines content) >>= return
       case line of
         (T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< T.readFile f'
           where
-            f' = dir </> dropWhile isSpace (T.unpack f)
+            f' = dir </> T.unpack (T.dropWhile isSpace f)
             dir' = takeDirectory f'
         _ -> return line
 
@@ -240,7 +241,7 @@ validateRules rules = do
 -- | A set of data definitions and account-matching patterns sufficient to
 -- convert a particular CSV data file into meaningful journal transactions.
 data CsvRules' a = CsvRules' {
-  rdirectives        :: [(DirectiveName,String)],
+  rdirectives        :: [(DirectiveName,Text)],
     -- ^ top-level rules, as (keyword, value) pairs
   rcsvfieldindexes   :: [(CsvFieldName, CsvFieldIndex)],
     -- ^ csv field names and their column number, if declared by a fields list
@@ -260,7 +261,7 @@ type CsvRulesParsed = CsvRules' ()
 -- | Type used after parsing is done. Directives, assignments and conditional blocks
 -- are in the same order as they were in the unput file and rblocksassigning is functional.
 -- Ready to be used for CSV record processing
-type CsvRules = CsvRules' (String -> [ConditionalBlock])
+type CsvRules = CsvRules' (Text -> [ConditionalBlock])
 
 instance Eq CsvRules where
   r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) ==
@@ -277,27 +278,27 @@ instance Show CsvRules where
 type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a
 
 -- | The keyword of a CSV rule - "fields", "skip", "if", etc.
-type DirectiveName    = String
+type DirectiveName    = Text
 
 -- | CSV field name.
-type CsvFieldName     = String
+type CsvFieldName     = Text
 
 -- | 1-based CSV column number.
 type CsvFieldIndex    = Int
 
 -- | Percent symbol followed by a CSV field name or column number. Eg: %date, %1.
-type CsvFieldReference = String
+type CsvFieldReference = Text
 
 -- | One of the standard hledger fields or pseudo-fields that can be assigned to.
 -- Eg date, account1, amount, amount1-in, date-format.
-type HledgerFieldName = String
+type HledgerFieldName = Text
 
 -- | A text value to be assigned to a hledger field, possibly
 -- containing csv field references to be interpolated.
-type FieldTemplate    = String
+type FieldTemplate    = Text
 
 -- | A strptime date parsing pattern, as supported by Data.Time.Format.
-type DateFormat       = String
+type DateFormat       = Text
 
 -- | A prefix for a matcher test, either & or none (implicit or).
 data MatcherPrefix = And | None
@@ -453,16 +454,16 @@ commentlinep = lift skipNonNewlineSpaces >> commentcharp >> lift restofline >> r
 commentcharp :: CsvRulesParser Char
 commentcharp = oneOf (";#*" :: [Char])
 
-directivep :: CsvRulesParser (DirectiveName, String)
+directivep :: CsvRulesParser (DirectiveName, Text)
 directivep = (do
   lift $ dbgparse 8 "trying directive"
-  d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives
+  d <- choiceInState $ map (lift . string) directives
   v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)
        <|> (optional (char ':') >> lift skipNonNewlineSpaces >> lift eolof >> return "")
   return (d, v)
   ) <?> "directive"
 
-directives :: [String]
+directives :: [Text]
 directives =
   ["date-format"
   ,"decimal-mark"
@@ -474,8 +475,8 @@ directives =
   , "balance-type"
   ]
 
-directivevalp :: CsvRulesParser String
+directivevalp :: CsvRulesParser Text
-directivevalp = anySingle `manyTill` lift eolof
+directivevalp = T.pack <$> anySingle `manyTill` lift eolof
 
 fieldnamelistp :: CsvRulesParser [CsvFieldName]
 fieldnamelistp = (do
@@ -487,21 +488,18 @@ fieldnamelistp = (do
   f <- fromMaybe "" <$> optional fieldnamep
   fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)
   lift restofline
-  return $ map (map toLower) $ f:fs
+  return . map T.toLower $ f:fs
   ) <?> "field name list"
 
-fieldnamep :: CsvRulesParser String
+fieldnamep :: CsvRulesParser Text
 fieldnamep = quotedfieldnamep <|> barefieldnamep
 
-quotedfieldnamep :: CsvRulesParser String
+quotedfieldnamep :: CsvRulesParser Text
-quotedfieldnamep = do
+quotedfieldnamep =
-  char '"'
+    char '"' *> takeWhile1P Nothing (`notElem` ("\"\n:;#~" :: [Char])) <* char '"'
-  f <- some $ noneOf ("\"\n:;#~" :: [Char])
-  char '"'
-  return f
 
-barefieldnamep :: CsvRulesParser String
+barefieldnamep :: CsvRulesParser Text
-barefieldnamep = some $ noneOf (" \t\n,;#~" :: [Char])
+barefieldnamep = takeWhile1P Nothing (`notElem` (" \t\n,;#~" :: [Char]))
 
 fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)
 fieldassignmentp = do
@@ -513,10 +511,10 @@ fieldassignmentp = do
   return (f,v)
   <?> "field assignment"
 
-journalfieldnamep :: CsvRulesParser String
+journalfieldnamep :: CsvRulesParser Text
 journalfieldnamep = do
   lift (dbgparse 8 "trying journalfieldnamep")
-  T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames)
+  choiceInState $ map (lift . string) journalfieldnames
 
 maxpostings = 99
 
@@ -524,14 +522,14 @@ maxpostings = 99
 -- Names must precede any other name they contain, for the parser
 -- (amount-in before amount; date2 before date). TODO: fix
 journalfieldnames =
-  concat [[ "account" ++ i
+  concat [[ "account" <> i
-          ,"amount" ++ i ++ "-in"
+          ,"amount" <> i <> "-in"
-          ,"amount" ++ i ++ "-out"
+          ,"amount" <> i <> "-out"
-          ,"amount" ++ i
+          ,"amount" <> i
-          ,"balance" ++ i
+          ,"balance" <> i
-          ,"comment" ++ i
+          ,"comment" <> i
-          ,"currency" ++ i
+          ,"currency" <> i
-          ] | x <- [maxpostings, (maxpostings-1)..1], let i = show x]
+          ] | x <- [maxpostings, (maxpostings-1)..1], let i = T.pack $ show x]
   ++
   ["amount-in"
   ,"amount-out"
@@ -556,10 +554,10 @@ assignmentseparatorp = do
                      ]
   return ()
 
-fieldvalp :: CsvRulesParser String
+fieldvalp :: CsvRulesParser Text
 fieldvalp = do
   lift $ dbgparse 8 "trying fieldvalp"
-  anySingle `manyTill` lift eolof
+  T.pack <$> anySingle `manyTill` lift eolof
 
 -- A conditional block: one or more matchers, one per line, followed by one or more indented rules.
 conditionalblockp :: CsvRulesParser ConditionalBlock
@@ -587,14 +585,14 @@ conditionaltablep :: CsvRulesParser [ConditionalBlock]
 conditionaltablep = do
   lift $ dbgparse 8 "trying conditionaltablep"
   start <- getOffset
-  string "if" 
+  string "if"
   sep <- lift $ satisfy (\c -> not (isAlphaNum c || isSpace c))
   fields <- journalfieldnamep `sepBy1` (char sep)
   newline
   body <- flip manyTill (lift eolof) $ do
     off <- getOffset
     m <- matcherp' (char sep >> return ())
-    vs <- LS.splitOn [sep] <$> lift restofline
+    vs <- T.split (==sep) . T.pack <$> lift restofline
     if (length vs /= length fields)
       then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d\n" (length fields) (length vs)) :: String)
       else return (m,vs)
@@ -655,8 +653,7 @@ csvfieldreferencep :: CsvRulesParser CsvFieldReference
 csvfieldreferencep = do
   lift $ dbgparse 8 "trying csvfieldreferencep"
   char '%'
-  f <- fieldnamep
+  T.cons '%' . textQuoteIfNeeded <$> fieldnamep
-  return $ '%' : quoteIfNeeded f
 
 -- A single regular expression
 regexp :: CsvRulesParser () -> CsvRulesParser Regexp
@@ -665,7 +662,7 @@ regexp end = do
   -- notFollowedBy matchoperatorp
   c <- lift nonspace
   cs <- anySingle `manyTill` end
-  case toRegexCI . strip $ c:cs of
+  case toRegexCI . T.strip . T.pack $ c:cs of
        Left x -> Fail.fail $ "CSV parser: " ++ x
        Right x -> return x
 
@@ -721,7 +718,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
   let skiplines = case getDirective "skip" rules of
                     Nothing -> 0
                     Just "" -> 1
-                    Just s  -> readDef (throwerr $ "could not parse skip value: " ++ show s) s
+                    Just s  -> readDef (throwerr $ "could not parse skip value: " ++ show s) $ T.unpack s
 
   -- parse csv
   let
@@ -779,18 +776,17 @@ readJournalFromCsv mrulesfile csvfile csvdata =
 
   when (not rulesfileexists) $ do
     dbg1IO "creating conversion rules file" rulesfile
-    writeFile rulesfile $ T.unpack rulestext
+    T.writeFile rulesfile rulestext
 
   return $ Right nulljournal{jtxns=txns''}
 
 -- | Parse special separator names TAB and SPACE, or return the first
 -- character. Return Nothing on empty string
-parseSeparator :: String -> Maybe Char
+parseSeparator :: Text -> Maybe Char
-parseSeparator = specials . map toLower
+parseSeparator = specials . T.toLower
   where specials "space" = Just ' '
         specials "tab"   = Just '\t'
-        specials (x:_)   = Just x
+        specials xs      = fst <$> T.uncons xs
-        specials []      = Nothing
 
 parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV)
 parseCsv separator filePath csvdata =
@@ -813,15 +809,13 @@ parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV
 parseResultToCsv = toListList . unpackFields
     where
         toListList = toList . fmap toList
-        unpackFields  = (fmap . fmap) (T.unpack . T.decodeUtf8)
+        unpackFields  = (fmap . fmap) T.decodeUtf8
 
-printCSV :: CSV -> String
+printCSV :: CSV -> TL.Text
-printCSV records = unlined (printRecord `map` records)
+printCSV = TB.toLazyText . unlined . map printRecord
-    where printRecord = concat . intersperse "," . map printField
+    where printRecord = mconcat . map TB.fromText . intersperse "," . map printField
-          printField f = "\"" ++ concatMap escape f ++ "\""
+          printField = wrap "\"" "\"" . T.replace "\"" "\\\"\\\""
-          escape '"' = "\"\""
+          unlined = (<> TB.fromText "\n") . mconcat . intersperse "\n"
-          escape x = [x]
-          unlined = concat . intersperse "\n"
 
 -- | Return the cleaned up and validated CSV data (can be empty), or an error.
 validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord]
@@ -834,7 +828,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr
         (Nothing, Nothing) -> Nothing
         (Just _, _) -> Just maxBound
         (Nothing, Just "") -> Just 1
-        (Nothing, Just x) -> Just (read x)
+        (Nothing, Just x) -> Just (read $ T.unpack x)
     applyConditionalSkips [] = []
     applyConditionalSkips (r:rest) =
       case skipCount r of
@@ -866,7 +860,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr
 --- ** converting csv records to transactions
 
 showRules rules record =
-  unlines $ catMaybes [ (("the "++fld++" rule is: ")++) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]
+  T.unlines $ catMaybes [ (("the "<>fld<>" rule is: ")<>) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]
 
 -- | Look up the value (template) of a csv rule by rule keyword.
 csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
@@ -880,7 +874,7 @@ hledgerField = getEffectiveAssignment
 
 -- | Look up the final value assigned to a hledger field, with csv field
 -- references interpolated.
-hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String
+hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
 hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record
 
 transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
@@ -892,18 +886,18 @@ transactionFromCsvRecord sourcepos rules record = t
     rule     = csvRule           rules        :: DirectiveName    -> Maybe FieldTemplate
     -- ruleval  = csvRuleValue      rules record :: DirectiveName    -> Maybe String
     field    = hledgerField      rules record :: HledgerFieldName -> Maybe FieldTemplate
-    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
+    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
     parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format")
-    mkdateerror datefield datevalue mdateformat = unlines
+    mkdateerror datefield datevalue mdateformat = T.unpack $ T.unlines
-      ["error: could not parse \""++datevalue++"\" as a date using date format "
+      ["error: could not parse \""<>datevalue<>"\" as a date using date format "
-        ++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat
+        <>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat
       ,showRecord record
-      ,"the "++datefield++" rule is:   "++(fromMaybe "required, but missing" $ field datefield)
+      ,"the "<>datefield<>" rule is:   "<>(fromMaybe "required, but missing" $ field datefield)
-      ,"the date-format is: "++fromMaybe "unspecified" mdateformat
+      ,"the date-format is: "<>fromMaybe "unspecified" mdateformat
       ,"you may need to "
-        ++"change your "++datefield++" rule, "
+        <>"change your "<>datefield<>" rule, "
-        ++maybe "add a" (const "change your") mdateformat++" date-format rule, "
+        <>maybe "add a" (const "change your") mdateformat<>" date-format rule, "
-        ++"or "++maybe "add a" (const "change your") mskip++" skip rule"
+        <>"or "<>maybe "add a" (const "change your") mskip<>" skip rule"
       ,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
       ]
       where
@@ -923,25 +917,27 @@ transactionFromCsvRecord sourcepos rules record = t
     status      =
       case fieldval "status" of
         Nothing -> Unmarked
-        Just s  -> either statuserror id $ runParser (statusp <* eof) "" $ T.pack s
+        Just s  -> either statuserror id $ runParser (statusp <* eof) "" s
           where
-            statuserror err = error' $ unlines
+            statuserror err = error' . T.unpack $ T.unlines
-              ["error: could not parse \""++s++"\" as a cleared status (should be *, ! or empty)"
+              ["error: could not parse \""<>s<>"\" as a cleared status (should be *, ! or empty)"
-              ,"the parse error is:      "++customErrorBundlePretty err
+              ,"the parse error is:      "<>T.pack (customErrorBundlePretty err)
               ]
     code        = maybe "" singleline $ fieldval "code"
     description = maybe "" singleline $ fieldval "description"
     comment     = maybe "" singleline $ fieldval "comment"
     precomment  = maybe "" singleline $ fieldval "precomment"
 
+    singleline = T.unwords . filter (not . T.null) . map T.strip . T.lines
+
     ----------------------------------------------------------------------
     -- 3. Generate the postings for which an account has been assigned
     -- (possibly indirectly due to an amount or balance assignment)
 
-    p1IsVirtual = (accountNamePostingType . T.pack <$> fieldval "account1") == Just VirtualPosting
+    p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting
     ps = [p | n <- [1..maxpostings]
-         ,let comment  = T.pack $ fromMaybe "" $ fieldval ("comment"++show n)
+         ,let comment  = fromMaybe "" $ fieldval ("comment"<> T.pack (show n))
-         ,let currency = fromMaybe "" (fieldval ("currency"++show n) <|> fieldval "currency")
+         ,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency")
          ,let mamount  = getAmount rules record currency p1IsVirtual n
          ,let mbalance = getBalance rules record currency n
          ,Just (acct,isfinal) <- [getAccount rules record mamount mbalance n]  -- skips Nothings
@@ -965,10 +961,10 @@ transactionFromCsvRecord sourcepos rules record = t
           ,tdate             = date'
           ,tdate2            = mdate2'
           ,tstatus           = status
-          ,tcode             = T.pack code
+          ,tcode             = code
-          ,tdescription      = T.pack description
+          ,tdescription      = description
-          ,tcomment          = T.pack comment
+          ,tcomment          = comment
-          ,tprecedingcomment = T.pack precomment
+          ,tprecedingcomment = precomment
           ,tpostings         = ps
           }  
 
@@ -979,7 +975,7 @@ transactionFromCsvRecord sourcepos rules record = t
 -- For postings 1 or 2 it also looks at "amount", "amount-in", "amount-out".
 -- If more than one of these has a value, it looks for one that is non-zero.
 -- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error.
-getAmount :: CsvRules -> CsvRecord -> String -> Bool -> Int -> Maybe MixedAmount
+getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount
 getAmount rules record currency p1IsVirtual n =
   -- Warning, many tricky corner cases here.
   -- docs: hledger_csv.m4.md #### amount
@@ -988,14 +984,15 @@ getAmount rules record currency p1IsVirtual n =
     unnumberedfieldnames = ["amount","amount-in","amount-out"]
 
     -- amount field names which can affect this posting
-    fieldnames = map (("amount"++show n)++) ["","-in","-out"]
+    fieldnames = map (("amount"<> T.pack(show n))<>) ["","-in","-out"]
                  -- For posting 1, also recognise the old amount/amount-in/amount-out names.
                  -- For posting 2, the same but only if posting 1 needs balancing.
                  ++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else []
 
     -- assignments to any of these field names with non-empty values
     assignments = [(f,a') | f <- fieldnames
-                          , Just v@(_:_) <- [strip . renderTemplate rules record <$> hledgerField rules record f]
+                          , Just v <- [T.strip . renderTemplate rules record <$> hledgerField rules record f]
+                          , not $ T.null v
                           , let a = parseAmount rules record currency v
                           -- With amount/amount-in/amount-out, in posting 2,
                           -- flip the sign and convert to cost, as they did before 1.17
@@ -1006,7 +1003,7 @@ getAmount rules record currency p1IsVirtual n =
     assignments' | any isnumbered assignments = filter isnumbered assignments
                  | otherwise                  = assignments
       where
-        isnumbered (f,_) = any (flip elem ['0'..'9']) f
+        isnumbered (f,_) = T.any (flip elem ['0'..'9']) f
 
     -- if there's more than one value and only some are zeros, discard the zeros
     assignments''
@@ -1017,24 +1014,24 @@ getAmount rules record currency p1IsVirtual n =
   in case -- dbg0 ("amounts for posting "++show n)
           assignments'' of
       [] -> Nothing
-      [(f,a)] | "-out" `isSuffixOf` f -> Just (-a)  -- for -out fields, flip the sign
+      [(f,a)] | "-out" `T.isSuffixOf` f -> Just (-a)  -- for -out fields, flip the sign
       [(_,a)] -> Just a
-      fs      -> error' $ unlines $ [  -- PARTIAL:
+      fs      -> error' . T.unpack . T.unlines $ [  -- PARTIAL:
          "multiple non-zero amounts or multiple zero amounts assigned,"
         ,"please ensure just one. (https://hledger.org/csv.html#amount)"
-        ,"  " ++ showRecord record
+        ,"  " <> showRecord record
-        ,"  for posting: " ++ show n
+        ,"  for posting: " <> T.pack (show n)
         ]
-        ++ ["  assignment: " ++ f ++ " " ++
+        ++ ["  assignment: " <> f <> " " <>
-             fromMaybe "" (hledgerField rules record f) ++
+             fromMaybe "" (hledgerField rules record f) <>
-             "\t=> value: " ++ showMixedAmount a -- XXX not sure this is showing all the right info
+             "\t=> value: " <> wbToText (showMixedAmountB noColour a) -- XXX not sure this is showing all the right info
            | (f,a) <- fs]
 
 -- | Figure out the expected balance (assertion or assignment) specified for posting N,
 -- if any (and its parse position).
-getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos)
+getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, GenericSourcePos)
 getBalance rules record currency n = do
-  v <- (fieldval ("balance"++show n)
+  v <- (fieldval ("balance"<> T.pack (show n))
         -- for posting 1, also recognise the old field name
         <|> if n==1 then fieldval "balance" else Nothing)
   case v of
@@ -1043,30 +1040,29 @@ getBalance rules record currency n = do
             parseBalanceAmount rules record currency n s
            ,nullsourcepos  -- parse position to show when assertion fails,
            )               -- XXX the csv record's line number would be good
-  
   where
-    fieldval = fmap strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
+    fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
 
 -- | Given a non-empty amount string (from CSV) to parse, along with a
 -- possibly non-empty currency symbol to prepend,
 -- parse as a hledger MixedAmount (as in journal format), or raise an error.
 -- The whole CSV record is provided for the error message.
-parseAmount :: CsvRules -> CsvRecord -> String -> String -> MixedAmount
+parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount
 parseAmount rules record currency s =
-  either mkerror (Mixed . (:[])) $  -- PARTIAL:
+    either mkerror (Mixed . (:[])) $  -- PARTIAL:
-  runParser (evalStateT (amountp <* eof) journalparsestate) "" $
+    runParser (evalStateT (amountp <* eof) journalparsestate) "" $
-  T.pack $ (currency++) $ simplifySign s
+    currency <> simplifySign s
   where
     journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}
-    mkerror e = error' $ unlines
+    mkerror e = error' . T.unpack $ T.unlines
-      ["error: could not parse \""++s++"\" as an amount"
+      ["error: could not parse \"" <> s <> "\" as an amount"
       ,showRecord record
       ,showRules rules record
       -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)
-      ,"the parse error is:      "++customErrorBundlePretty e
+      ,"the parse error is:      " <> T.pack (customErrorBundlePretty e)
-      ,"you may need to "
+      ,"you may need to \
-        ++"change your amount*, balance*, or currency* rules, "
+        \change your amount*, balance*, or currency* rules, \
-        ++"or add or change your skip rule"
+        \or add or change your skip rule"
       ]
 
 -- XXX unify these ^v
@@ -1076,30 +1072,30 @@ parseAmount rules record currency s =
 -- possibly non-empty currency symbol to prepend,
 -- parse as a hledger Amount (as in journal format), or raise an error.
 -- The CSV record and the field's numeric suffix are provided for the error message.
-parseBalanceAmount :: CsvRules -> CsvRecord -> String -> Int -> String -> Amount
+parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount
 parseBalanceAmount rules record currency n s =
   either (mkerror n s) id $
     runParser (evalStateT (amountp <* eof) journalparsestate) "" $
-    T.pack $ (currency++) $ simplifySign s
+    currency <> simplifySign s
                   -- the csv record's line number would be good
   where
     journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}
-    mkerror n s e = error' $ unlines
+    mkerror n s e = error' . T.unpack $ T.unlines
-      ["error: could not parse \""++s++"\" as balance"++show n++" amount"
+      ["error: could not parse \"" <> s <> "\" as balance"<> T.pack (show n) <> " amount"
       ,showRecord record
       ,showRules rules record
       -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency
-      ,"the parse error is:      "++customErrorBundlePretty e
+      ,"the parse error is:      "<> T.pack (customErrorBundlePretty e)
       ]
 
 -- Read a valid decimal mark from the decimal-mark rule, if any.
 -- If the rule is present with an invalid argument, raise an error.
 parseDecimalMark :: CsvRules -> Maybe DecimalMark
-parseDecimalMark rules =
+parseDecimalMark rules = do
-  case rules `csvRule` "decimal-mark" of
+    s <- rules `csvRule` "decimal-mark"
-    Nothing -> Nothing
+    case T.uncons s of
-    Just [c] | isDecimalMark c -> Just c
+        Just (c, rest) | T.null rest && isDecimalMark c -> return c
-    Just s -> error' $ "decimal-mark's argument should be \".\" or \",\" (not \""++s++"\")"
+        _ -> error' . T.unpack $ "decimal-mark's argument should be \".\" or \",\" (not \""<>s<>"\")"
 
 -- | Make a balance assertion for the given amount, with the given parse
 -- position (to be shown in assertion failures), with the assertion type
@@ -1116,8 +1112,8 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
         Just "=="  -> nullassertion{batotal=True}
         Just "=*"  -> nullassertion{bainclusive=True}
         Just "==*" -> nullassertion{batotal=True, bainclusive=True}
-        Just x     -> error' $ unlines  -- PARTIAL:
+        Just x     -> error' . T.unpack $ T.unlines  -- PARTIAL:
-          [ "balance-type \"" ++ x ++"\" is invalid. Use =, ==, =* or ==*."
+          [ "balance-type \"" <> x <>"\" is invalid. Use =, ==, =* or ==*."
           , showRecord record
           , showRules rules record
           ]
@@ -1128,8 +1124,8 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
 getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool)
 getAccount rules record mamount mbalance n =
   let
-    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
+    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
-    maccount = T.pack <$> fieldval ("account"++show n)
+    maccount = fieldval ("account"<> T.pack (show n))
   in case maccount of
     -- accountN is set to the empty string - no posting will be generated
     Just "" -> Nothing
@@ -1150,7 +1146,7 @@ getAccount rules record mamount mbalance n =
 unknownExpenseAccount = "expenses:unknown"
 unknownIncomeAccount  = "income:unknown"
 
-type CsvAmountString = String
+type CsvAmountString = Text
 
 -- | Canonicalise the sign in a CSV amount string.
 -- Such strings can have a minus sign, negating parentheses,
@@ -1171,18 +1167,20 @@ type CsvAmountString = String
 -- >>> simplifySign "((1))"
 -- "1"
 simplifySign :: CsvAmountString -> CsvAmountString
-simplifySign ('(':s) | lastMay s == Just ')' = simplifySign $ negateStr $ init s
+simplifySign amtstr
-simplifySign ('-':'(':s) | lastMay s == Just ')' = simplifySign $ init s
+  | Just ('(',t) <- T.uncons amtstr, Just (amt,')') <- T.unsnoc t = simplifySign $ negateStr amt
-simplifySign ('-':'-':s) = s
+  | Just ('-',b) <- T.uncons amtstr, Just ('(',t) <- T.uncons b, Just (amt,')') <- T.unsnoc t = simplifySign amt
-simplifySign s = s
+  | Just ('-',m) <- T.uncons amtstr, Just ('-',amt) <- T.uncons m = amt
+  | otherwise = amtstr
 
-negateStr :: String -> String
+negateStr :: Text -> Text
-negateStr ('-':s) = s
+negateStr amtstr = case T.uncons amtstr of
-negateStr s       = '-':s
+    Just ('-',s) -> s
+    _            -> T.cons '-' amtstr
 
 -- | Show a (approximate) recreation of the original CSV record.
-showRecord :: CsvRecord -> String
+showRecord :: CsvRecord -> Text
-showRecord r = "record values: "++intercalate "," (map show r)
+showRecord r = "record values: "<>T.intercalate "," (map (wrap "\"" "\"") r)
 
 -- | Given the conversion rules, a CSV record and a hledger field name, find
 -- the value template ultimately assigned to this field, if any, by a field
@@ -1208,7 +1206,7 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
               where
                 -- does this individual matcher match the current csv record ?
                 matcherMatches :: Matcher -> Bool
-                matcherMatches (RecordMatcher _ pat) = regexMatch pat' wholecsvline
+                matcherMatches (RecordMatcher _ pat) = regexMatchText pat' wholecsvline
                   where
                     pat' = dbg7 "regex" pat
                     -- A synthetic whole CSV record to match against. Note, this can be
@@ -1217,47 +1215,48 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
                     -- - any quotes enclosing field values are removed
                     -- - and the field separator is always comma
                     -- which means that a field containing a comma will look like two fields.
-                    wholecsvline = dbg7 "wholecsvline" $ intercalate "," record
+                    wholecsvline = dbg7 "wholecsvline" $ T.intercalate "," record
-                matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat csvfieldvalue
+                matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatchText pat csvfieldvalue
                   where
                     -- the value of the referenced CSV field to match against.
                     csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref
 
 -- | Render a field assignment's template, possibly interpolating referenced
 -- CSV field values. Outer whitespace is removed from interpolated values.
-renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> String
+renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> Text
-renderTemplate rules record t = maybe t concat $ parseMaybe
+renderTemplate rules record t = maybe t mconcat $ parseMaybe
     (many $ takeWhile1P Nothing (/='%')
         <|> replaceCsvFieldReference rules record <$> referencep)
     t
   where
-    referencep = liftA2 (:) (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr String String
+    referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr Text Text
     isDescriptorChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-')
 
 -- | Replace something that looks like a reference to a csv field ("%date" or "%1)
 -- with that field's value. If it doesn't look like a field reference, or if we
 -- can't find such a field, leave it unchanged.
-replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> String
+replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text
-replaceCsvFieldReference rules record s@('%':fieldname) = fromMaybe s $ csvFieldValue rules record fieldname
+replaceCsvFieldReference rules record s = case T.uncons s of
-replaceCsvFieldReference _ _ s = s
+    Just ('%', fieldname) -> fromMaybe s $ csvFieldValue rules record fieldname
+    _                     -> s
 
 -- | Get the (whitespace-stripped) value of a CSV field, identified by its name or
 -- column number, ("date" or "1"), from the given CSV record, if such a field exists.
-csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe String
+csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text
 csvFieldValue rules record fieldname = do
-  fieldindex <- if | all isDigit fieldname -> readMay fieldname
+  fieldindex <- if | T.all isDigit fieldname -> readMay $ T.unpack fieldname
-                   | otherwise             -> lookup (map toLower fieldname) $ rcsvfieldindexes rules
+                   | otherwise               -> lookup (T.toLower fieldname) $ rcsvfieldindexes rules
-  fieldvalue <- strip <$> atMay record (fieldindex-1)
+  fieldvalue <- T.strip <$> atMay record (fieldindex-1)
   return fieldvalue
 
 -- | Parse the date string using the specified date-format, or if unspecified
 -- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading
 -- zeroes optional).
-parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day
+parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> Text -> Maybe Day
 parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats
   where
-    parsewith = flip (parseTimeM True defaultTimeLocale) s
+    parsewith = flip (parseTimeM True defaultTimeLocale) (T.unpack s)
-    formats = maybe
+    formats = map T.unpack $ maybe
                ["%Y/%-m/%-d"
                ,"%Y-%-m-%-d"
                ,"%Y.%-m.%-d"

hledger-lib/Hledger/Read/JournalReader.hs

@@ -42,7 +42,7 @@ module Hledger.Read.JournalReader (
   -- * Reader-finding utils
   findReader,
   splitReaderPrefix,
-  
+
   -- * Reader
   reader,
 
@@ -380,8 +380,8 @@ parseAccountTypeCode s =
     "c"         -> Right Cash
     _           -> Left err
   where
-    err = "invalid account type code "++T.unpack s++", should be one of " ++
+    err = T.unpack $ "invalid account type code "<>s<>", should be one of " <>
-          (intercalate ", " $ ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"])
+            T.intercalate ", " ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"]
 
 -- Add an account declaration to the journal, auto-numbering it.
 addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m ()

hledger-lib/Hledger/Reports/AccountTransactionsReport.hs

@@ -18,6 +18,7 @@ where
 import Data.List
 import Data.Ord
 import Data.Maybe
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Calendar
 
@@ -64,26 +65,20 @@ import Hledger.Utils
 -- posts to the current account), most recent first.
 -- Reporting intervals are currently ignored.
 --
-type AccountTransactionsReport =
+type AccountTransactionsReport = [AccountTransactionsReportItem] -- line items, one per transaction
-  (String                          -- label for the balance column, eg "balance" or "total"
-  ,[AccountTransactionsReportItem] -- line items, one per transaction
-  )
 
 type AccountTransactionsReportItem =
   (
    Transaction -- the transaction, unmodified
   ,Transaction -- the transaction, as seen from the current account
   ,Bool        -- is this a split (more than one posting to other accounts) ?
-  ,String      -- a display string describing the other account(s), if any
+  ,Text        -- a display string describing the other account(s), if any
   ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)
   ,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction
   )
 
-totallabel   = "Period Total"
-balancelabel = "Historical Total"
-
 accountTransactionsReport :: ReportSpec -> Journal -> Query -> Query -> AccountTransactionsReport
-accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = (label, items)
+accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = items
   where
     -- a depth limit should not affect the account transactions report
     -- seems unnecessary for some reason XXX
@@ -129,9 +124,9 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = (
       ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) $
       sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4
 
-    (startbal,label)
+    startbal
-      | balancetype_ ropts == HistoricalBalance = (sumPostings priorps, balancelabel)
+      | balancetype_ ropts == HistoricalBalance = sumPostings priorps
-      | otherwise                               = (nullmixedamt,        totallabel)
+      | otherwise                               = nullmixedamt
       where
         priorps = dbg5 "priorps" $
                   filter (matchesPosting
@@ -216,9 +211,9 @@ transactionRegisterDate reportq thisacctq t
 
 -- | Generate a simplified summary of some postings' accounts.
 -- To reduce noise, if there are both real and virtual postings, show only the real ones.
-summarisePostingAccounts :: [Posting] -> String
+summarisePostingAccounts :: [Posting] -> Text
 summarisePostingAccounts ps =
-  (intercalate ", " . map (T.unpack . accountSummarisedName) . nub . map paccount) displayps -- XXX pack
+    T.intercalate ", " . map accountSummarisedName . nub $ map paccount displayps
   where
     realps = filter isReal ps
     displayps | null realps = ps

hledger-lib/Hledger/Reports/BudgetReport.hs

@@ -27,27 +27,27 @@ module Hledger.Reports.BudgetReport (
 )
 where
 
-import Data.Decimal
+import Data.Decimal (roundTo)
 import Data.Default (def)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HM
-import Data.List
+import Data.List (nub, partition, transpose)
 import Data.List.Extra (nubSort)
-import Data.Maybe
+import Data.Maybe (fromMaybe)
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Monoid ((<>))
 #endif
-import Safe
+import Safe (headDef)
 --import Data.List
 --import Data.Maybe
 import qualified Data.Map as Map
 import Data.Map (Map)
+import Data.Text (Text)
 import qualified Data.Text as T
---import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
 --import System.Console.CmdArgs.Explicit as C
 --import Lucid as L
-
-import Text.Printf (printf)
 import Text.Tabular as T
 import Text.Tabular.AsciiWide as T
 
@@ -68,7 +68,7 @@ type BudgetCell = (Maybe Change, Maybe BudgetGoal)
 type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
 type BudgetReport    = PeriodicReport    DisplayName BudgetCell
 
-type BudgetDisplayCell = ((String, Int), Maybe ((String, Int), Maybe (String, Int)))
+type BudgetDisplayCell = ((Text, Int), Maybe ((Text, Int), Maybe (Text, Int)))
 
 -- | Calculate per-account, per-period budget (balance change) goals
 -- from all periodic transactions, calculate actual balance changes 
@@ -219,23 +219,23 @@ combineBudgetAndActual ropts j
         totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change
 
 -- | Render a budget report as plain text suitable for console output.
-budgetReportAsText :: ReportOpts -> BudgetReport -> String
+budgetReportAsText :: ReportOpts -> BudgetReport -> TL.Text
-budgetReportAsText ropts@ReportOpts{..} budgetr =
+budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
-    title ++ "\n\n" ++
+    TB.fromText title <> TB.fromText "\n\n" <>
-    renderTable def{tableBorders=False,prettyTable=pretty_tables_}
+      renderTableB def{tableBorders=False,prettyTable=pretty_tables_}
         (alignCell TopLeft) (alignCell TopRight) (uncurry showcell) displayTableWithWidths
   where
-    title = printf "Budget performance in %s%s:"
+    title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
-      (showDateSpan $ periodicReportSpan budgetr)
+           <> (case value_ of
-      (case value_ of
+                 Just (AtCost _mc)   -> ", valued at cost"
-        Just (AtCost _mc)   -> ", valued at cost"
+                 Just (AtThen _mc)   -> error' unsupportedValueThenError  -- PARTIAL:
-        Just (AtThen _mc)   -> error' unsupportedValueThenError  -- PARTIAL:
+                 Just (AtEnd _mc)    -> ", valued at period ends"
-        Just (AtEnd _mc)    -> ", valued at period ends"
+                 Just (AtNow _mc)    -> ", current value"
-        Just (AtNow _mc)    -> ", current value"
+                 Just (AtDate d _mc) -> ", valued at " <> showDate d
-        Just (AtDate d _mc) -> ", valued at "++showDate d
+                 Nothing             -> "")
-        Nothing             -> "")
+           <> ":"
 
-    displayTableWithWidths :: Table String String ((Int, Int, Int), BudgetDisplayCell)
+    displayTableWithWidths :: Table Text Text ((Int, Int, Int), BudgetDisplayCell)
     displayTableWithWidths = Table rh ch $ map (zipWith (,) widths) displaycells
     Table rh ch displaycells = case budgetReportAsTable ropts budgetr of
         Table rh' ch' vals -> maybetranspose . Table rh' ch' $ map (map displayCell) vals
@@ -244,8 +244,8 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
       where
         actual' = fromMaybe 0 actual
         budgetAndPerc b = (showamt b, showper <$> percentage actual' b)
-        showamt = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) color_
+        showamt = (\(WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=Just 32}
-        showper p = let str = show (roundTo 0 p) in (str, length str)
+        showper p = let str = T.pack (show $ roundTo 0 p) in (str, T.length str)
     cellWidth ((_,wa), Nothing)                    = (wa,  0,  0)
     cellWidth ((_,wa), Just ((_,wb), Nothing))     = (wa, wb,  0)
     cellWidth ((_,wa), Just ((_,wb), Just (_,wp))) = (wa, wb, wp)
@@ -259,14 +259,17 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
     -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells
     showcell :: (Int, Int, Int) -> BudgetDisplayCell -> Cell
     showcell (actualwidth, budgetwidth, percentwidth) ((actual,wa), mbudget) =
-        Cell TopRight [(replicate (actualwidth - wa) ' ' ++ actual ++ budgetstr, actualwidth + totalbudgetwidth)]
+        Cell TopRight [WideBuilder ( TB.fromText (T.replicate (actualwidth - wa) " ")
+                                   <> TB.fromText actual
+                                   <> budgetstr
+                                   ) (actualwidth + totalbudgetwidth)]
       where
         totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
         totalbudgetwidth  = if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3
-        budgetstr = case mbudget of
+        budgetstr = TB.fromText $ case mbudget of
-          Nothing                             -> replicate totalbudgetwidth ' '
+          Nothing                             -> T.replicate totalbudgetwidth " "
-          Just ((budget, wb), Nothing)        -> " [" ++ replicate totalpercentwidth ' ' ++ replicate (budgetwidth - wb) ' ' ++ budget ++ "]"
+          Just ((budget, wb), Nothing)        -> " [" <> T.replicate totalpercentwidth " " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"
-          Just ((budget, wb), Just (pct, wp)) -> " [" ++ replicate (percentwidth - wp) ' ' ++ pct ++ "% of " ++ replicate (budgetwidth - wb) ' ' ++ budget ++ "]"
+          Just ((budget, wb), Just (pct, wp)) -> " [" <> T.replicate (percentwidth - wp) " " <> pct <> "% of " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"
 
     -- | Calculate the percentage of actual change to budget goal to show, if any.
     -- If valuing at cost, both amounts are converted to cost before comparing.
@@ -289,7 +292,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
                    | otherwise  = id
 
 -- | Build a 'Table' from a multi-column balance report.
-budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)
+budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text (Maybe MixedAmount, Maybe MixedAmount)
 budgetReportAsTable
   ropts@ReportOpts{balancetype_}
   (PeriodicReport spans rows (PeriodicReportRow _ coltots grandtot grandavg)) =
@@ -308,8 +311,8 @@ budgetReportAsTable
     -- budgetReport sets accountlistmode to ALTree. Find a principled way to do
     -- this.
     renderacct row = case accountlistmode_ ropts of
-        ALTree -> replicate ((prrDepth row - 1)*2) ' ' ++ T.unpack (prrDisplayName row)
+        ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row
-        ALFlat -> T.unpack . accountNameDrop (drop_ ropts) $ prrFullName row
+        ALFlat -> accountNameDrop (drop_ ropts) $ prrFullName row
     rowvals (PeriodicReportRow _ as rowtot rowavg) =
         as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts]
     addtotalrow
@@ -332,7 +335,7 @@ budgetReportAsTable
 -- - all other balance change reports: a description of the datespan,
 --   abbreviated to compact form if possible (see showDateSpan).
 --
-reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> String
+reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> T.Text
 reportPeriodName balancetype spans =
   case balancetype of
     PeriodChange -> if multiyear then showDateSpan else showDateSpanMonthAbbrev
@@ -344,20 +347,20 @@ reportPeriodName balancetype spans =
 -- | Render a budget report as CSV. Like multiBalanceReportAsCsv,
 -- but includes alternating actual and budget amount columns.
 budgetReportAsCsv :: ReportOpts -> BudgetReport -> CSV
-budgetReportAsCsv 
+budgetReportAsCsv
   ReportOpts{average_, row_total_, no_total_, transpose_}
   (PeriodicReport colspans items (PeriodicReportRow _ abtotals (magrandtot,mbgrandtot) (magrandavg,mbgrandavg)))
   = (if transpose_ then transpose else id) $
 
   -- heading row
-  ("Account" : 
+  ("Account" :
    concatMap (\span -> [showDateSpan span, "budget"]) colspans
    ++ concat [["Total"  ,"budget"] | row_total_]
    ++ concat [["Average","budget"] | average_]
   ) :
 
   -- account rows
-  [T.unpack (displayFull a) :
+  [displayFull a :
    map showmamt (flattentuples abamts)
    ++ concat [[showmamt mactualrowtot, showmamt mbudgetrowtot] | row_total_]
    ++ concat [[showmamt mactualrowavg, showmamt mbudgetrowavg] | average_]
@@ -369,7 +372,7 @@ budgetReportAsCsv
     [
     "Total:" :
     map showmamt (flattentuples abtotals)
-    ++ concat [[showmamt magrandtot,showmamt mbgrandtot] | row_total_] 
+    ++ concat [[showmamt magrandtot,showmamt mbgrandtot] | row_total_]
     ++ concat [[showmamt magrandavg,showmamt mbgrandavg] | average_]
     ]
   | not no_total_
@@ -377,7 +380,7 @@ budgetReportAsCsv
 
   where
     flattentuples abs = concat [[a,b] | (a,b) <- abs]
-    showmamt = maybe "" (showMixedAmountOneLineWithoutPrice False)
+    showmamt = maybe "" (wbToText . showMixedAmountB oneLine)
 
 -- tests
 

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -24,8 +24,7 @@ where
 import Data.List
 import Data.List.Extra (nubSort)
 import Data.Maybe
--- import Data.Text (Text)
+import Data.Text (Text)
-import qualified Data.Text as T
 import Data.Time.Calendar
 import Safe (headMay, lastMay)
 
@@ -35,12 +34,10 @@ import Hledger.Utils
 import Hledger.Reports.ReportOptions
 
 
--- | A postings report is a list of postings with a running total, a label
+-- | A postings report is a list of postings with a running total, and a little extra
--- for the total field, and a little extra transaction info to help with rendering.
+-- transaction info to help with rendering.
 -- This is used eg for the register command.
-type PostingsReport = (String               -- label for the running balance column XXX remove
+type PostingsReport = [PostingsReportItem] -- line items, one per posting
-                      ,[PostingsReportItem] -- line items, one per posting
-                      )
 type PostingsReportItem = (Maybe Day    -- The posting date, if this is the first posting in a
                                         -- transaction or if it's different from the previous
                                         -- posting's date. Or if this a summary posting, the
@@ -49,7 +46,7 @@ type PostingsReportItem = (Maybe Day    -- The posting date, if this is the firs
                           ,Maybe Day    -- If this is a summary posting, the report interval's
                                         -- end date if this is the first summary posting in
                                         -- the interval.
-                          ,Maybe String -- The posting's transaction's description, if this is the first posting in the transaction.
+                          ,Maybe Text   -- The posting's transaction's description, if this is the first posting in the transaction.
                           ,Posting      -- The posting, possibly with the account name depth-clipped.
                           ,MixedAmount  -- The running total after this posting, or with --average,
                                         -- the running average posting amount. With --historical,
@@ -66,8 +63,7 @@ type SummaryPosting = (Posting, Day)
 -- | Select postings from the journal and add running balance and other
 -- information to make a postings report. Used by eg hledger's register command.
 postingsReport :: ReportSpec -> Journal -> PostingsReport
-postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =
+postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
-  (totallabel, items)
     where
       reportspan  = adjustReportDates rspec j
       whichdate   = whichDateFromOpts ropts
@@ -130,8 +126,6 @@ registerRunningCalculationFn ropts
   | average_ ropts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg)
   | otherwise      = \_ bal amt -> bal + amt
 
-totallabel = "Total"
-
 -- | Adjust report start/end dates to more useful ones based on
 -- journal data and report intervals. Ie:
 -- 1. If the start date is unspecified, use the earliest date in the journal (if any)
@@ -206,14 +200,13 @@ mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Day -> Posting -> Mix
 mkpostingsReportItem showdate showdesc wd menddate p b =
   (if showdate then Just date else Nothing
   ,menddate
-  ,if showdesc then Just desc else Nothing
+  ,if showdesc then tdescription <$> ptransaction p else Nothing
   ,p
   ,b
   )
   where
     date = case wd of PrimaryDate   -> postingDate p
                       SecondaryDate -> postingDate2 p
-    desc = T.unpack $ maybe "" tdescription $ ptransaction p
 
 -- | Convert a list of postings into summary postings, one per interval,
 -- aggregated to the specified depth if any.
@@ -267,7 +260,7 @@ negatePostingAmount p = p { pamount = negate $ pamount p }
 tests_PostingsReport = tests "PostingsReport" [
 
    test "postingsReport" $ do
-    let (query, journal) `gives` n = (length $ snd $ postingsReport defreportspec{rsQuery=query} journal) @?= n
+    let (query, journal) `gives` n = (length $ postingsReport defreportspec{rsQuery=query} journal) @?= n
     -- with the query specified explicitly
     (Any, nulljournal) `gives` 0
     (Any, samplejournal) `gives` 13
@@ -276,10 +269,10 @@ tests_PostingsReport = tests "PostingsReport" [
     (And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2
     (And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2
     -- with query and/or command-line options
-    (length $ snd $ postingsReport defreportspec samplejournal) @?= 13
+    (length $ postingsReport defreportspec samplejournal) @?= 13
-    (length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
+    (length $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
-    (length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
+    (length $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
-    (length $ snd $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
+    (length $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
 
      -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
      -- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking             $1,$1)

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -167,7 +167,7 @@ rawOptsToReportOpts rawopts = do
     supports_color <- hSupportsANSIColor stdout
 
     let colorflag    = stringopt "color" rawopts
-        formatstring = maybestringopt "format" rawopts
+        formatstring = T.pack <$> maybestringopt "format" rawopts
         querystring  = map T.pack $ listofstringopt "args" rawopts  -- doesn't handle an arg like "" right
 
     format <- case parseStringFormat <$> formatstring of

hledger-lib/Hledger/Reports/ReportTypes.hs

@@ -32,9 +32,10 @@ module Hledger.Reports.ReportTypes
 , prrDepth
 ) where
 
-import Data.Aeson
+import Data.Aeson (ToJSON(..))
-import Data.Decimal
+import Data.Decimal (Decimal)
 import Data.Maybe (mapMaybe)
+import Data.Text (Text)
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Semigroup (Semigroup(..))
 #endif
@@ -144,16 +145,16 @@ prrMapMaybeName f row = case f $ prrName row of
 -- It is used in compound balance report commands like balancesheet,
 -- cashflow and incomestatement.
 data CompoundPeriodicReport a b = CompoundPeriodicReport
-  { cbrTitle      :: String
+  { cbrTitle      :: Text
   , cbrDates      :: [DateSpan]
-  , cbrSubreports :: [(String, PeriodicReport a b, Bool)]
+  , cbrSubreports :: [(Text, PeriodicReport a b, Bool)]
   , cbrTotals     :: PeriodicReportRow () b
   } deriving (Show, Functor, Generic, ToJSON)
 
 -- | Description of one subreport within a compound balance report.
 -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib.
 data CBCSubreportSpec a = CBCSubreportSpec
-  { cbcsubreporttitle          :: String                    -- ^ The title to use for the subreport
+  { cbcsubreporttitle          :: Text                      -- ^ The title to use for the subreport
   , cbcsubreportquery          :: Journal -> Query          -- ^ The Query to use for the subreport
   , cbcsubreportoptions        :: ReportOpts -> ReportOpts  -- ^ A function to transform the ReportOpts used to produce the subreport
   , cbcsubreporttransform      :: PeriodicReport DisplayName MixedAmount -> PeriodicReport a MixedAmount  -- ^ A function to transform the result of the subreport

hledger-lib/Hledger/Reports/TransactionsReport.hs

@@ -23,6 +23,7 @@ where
 
 import Data.List
 import Data.List.Extra (nubSort)
+import Data.Text (Text)
 import Data.Ord
 
 import Hledger.Data
@@ -34,18 +35,14 @@ import Hledger.Utils
 
 -- | A transactions report includes a list of transactions touching multiple accounts
 -- (posting-filtered and unfiltered variants), a running balance, and some
--- other information helpful for rendering a register view (a flag
+-- other information helpful for rendering a register view with or without a notion
--- indicating multiple other accounts and a display string describing
+-- of current account(s). Two kinds of report use this data structure, see transactionsReport
--- them) with or without a notion of current account(s).
--- Two kinds of report use this data structure, see transactionsReport
 -- and accountTransactionsReport below for details.
-type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"
+type TransactionsReport = [TransactionsReportItem] -- line items, one per transaction
-                          ,[TransactionsReportItem] -- line items, one per transaction
-                          )
 type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified
                               ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered
                               ,Bool        -- is this a split, ie more than one other account posting
-                              ,String      -- a display string describing the other account(s), if any
+                              ,Text        -- a display string describing the other account(s), if any
                               ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted)
                               ,MixedAmount -- the running total of item amounts, starting from zero;
                                            -- or with --historical, the running total including items
@@ -59,14 +56,12 @@ triBalance (_,_,_,_,_,a) = a
 triCommodityAmount c = filterMixedAmountByCommodity c  . triAmount
 triCommodityBalance c = filterMixedAmountByCommodity c  . triBalance
 
-totallabel   = "Period Total"
-
 -- | Select transactions from the whole journal. This is similar to a
 -- "postingsReport" except with transaction-based report items which
 -- are ordered most recent first. XXX Or an EntriesReport - use that instead ?
 -- This is used by hledger-web's journal view.
 transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
-transactionsReport opts j q = (totallabel, items)
+transactionsReport opts j q = items
    where
      -- XXX items' first element should be the full transaction with all postings
      items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts
@@ -79,15 +74,14 @@ transactionsReportByCommodity :: TransactionsReport -> [(CommoditySymbol, Transa
 transactionsReportByCommodity tr =
   [(c, filterTransactionsReportByCommodity c tr) | c <- transactionsReportCommodities tr]
   where
-    transactionsReportCommodities (_,items) =
+    transactionsReportCommodities = nubSort . map acommodity . concatMap (amounts . triAmount)
-      nubSort . map acommodity $ concatMap (amounts . triAmount) items
 
 -- Remove transaction report items and item amount (and running
 -- balance amount) components that don't involve the specified
 -- commodity. Other item fields such as the transaction are left unchanged.
 filterTransactionsReportByCommodity :: CommoditySymbol -> TransactionsReport -> TransactionsReport
-filterTransactionsReportByCommodity c (label,items) =
+filterTransactionsReportByCommodity c =
-  (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items])
+    fixTransactionsReportItemBalances . concatMap (filterTransactionsReportItemByCommodity c)
   where
     filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal)
       | c `elem` cs = [item']

hledger-lib/Hledger/Utils/Color.hs

@@ -1,17 +1,25 @@
 -- | Basic color helpers for prettifying console output.
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Hledger.Utils.Color
 (
   color,
   bgColor,
+  colorB,
+  bgColorB,
   Color(..),
   ColorIntensity(..)
 )
 where
 
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
+import qualified Data.Text.Lazy.Builder as TB
 import System.Console.ANSI
+import Hledger.Utils.Text (WideBuilder(..))
 
 
 -- | Wrap a string in ANSI codes to set and reset foreground colour.
@@ -21,3 +29,13 @@ color int col s = setSGRCode [SetColor Foreground int col] ++ s ++ setSGRCode []
 -- | Wrap a string in ANSI codes to set and reset background colour.
 bgColor :: ColorIntensity -> Color -> String -> String
 bgColor int col s = setSGRCode [SetColor Background int col] ++ s ++ setSGRCode []
+
+-- | Wrap a WideBuilder in ANSI codes to set and reset foreground colour.
+colorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
+colorB int col (WideBuilder s w) =
+    WideBuilder (TB.fromString (setSGRCode [SetColor Foreground int col]) <> s <> TB.fromString (setSGRCode [])) w
+
+-- | Wrap a WideBuilder in ANSI codes to set and reset background colour.
+bgColorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
+bgColorB int col (WideBuilder s w) =
+    WideBuilder (TB.fromString (setSGRCode [SetColor Background int col]) <> s <> TB.fromString (setSGRCode [])) w

hledger-lib/Hledger/Utils/Regex.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 {-|
@@ -54,6 +56,7 @@ module Hledger.Utils.Regex (
   ,RegexError
    -- * total regex operations
   ,regexMatch
+  ,regexMatchText
   ,regexReplace
   ,regexReplaceUnmemo
   ,regexReplaceAllBy
@@ -66,6 +69,10 @@ import Data.Array ((!), elems, indices)
 import Data.Char (isDigit)
 import Data.List (foldl')
 import Data.MemoUgly (memo)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
+import Data.Text (Text)
 import qualified Data.Text as T
 import Text.Regex.TDFA (
   Regex, CompOption(..), defaultCompOpt, defaultExecOpt,
@@ -78,8 +85,8 @@ import Hledger.Utils.UTF8IOCompat (error')
 
 -- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax.
 data Regexp
-  = Regexp   { reString :: String, reCompiled :: Regex }
+  = Regexp   { reString :: Text, reCompiled :: Regex }
-  | RegexpCI { reString :: String, reCompiled :: Regex }
+  | RegexpCI { reString :: Text, reCompiled :: Regex }
 
 instance Eq Regexp where
   Regexp   s1 _ == Regexp   s2 _ = s1 == s2
@@ -93,7 +100,7 @@ instance Ord Regexp where
   RegexpCI _ _ `compare` Regexp _ _ = GT
 
 instance Show Regexp where
-  showsPrec d r = showParen (d > app_prec) $ reCons . showsPrec (app_prec+1) (reString r)
+  showsPrec d r = showParen (d > app_prec) $ reCons . showsPrec (app_prec+1) (T.unpack $ reString r)
     where app_prec = 10
           reCons = case r of Regexp   _ _ -> showString "Regexp "
                              RegexpCI _ _ -> showString "RegexpCI "
@@ -108,8 +115,8 @@ instance Read Regexp where
     where app_prec = 10
 
 instance ToJSON Regexp where
-  toJSON (Regexp   s _) = String . T.pack $ "Regexp "   ++ s
+  toJSON (Regexp   s _) = String $ "Regexp "   <> s
-  toJSON (RegexpCI s _) = String . T.pack $ "RegexpCI " ++ s
+  toJSON (RegexpCI s _) = String $ "RegexpCI " <> s
 
 instance RegexLike Regexp String where
   matchOnce = matchOnce . reCompiled
@@ -124,24 +131,24 @@ instance RegexContext Regexp String String where
   matchM = matchM . reCompiled
 
 -- Convert a Regexp string to a compiled Regex, or return an error message.
-toRegex :: String -> Either RegexError Regexp
+toRegex :: Text -> Either RegexError Regexp
-toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s)
+toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM (T.unpack s))  -- Have to unpack here because Text instance in regex-tdfa only appears in 1.3.1
 
 -- Like toRegex, but make a case-insensitive Regex.
-toRegexCI :: String -> Either RegexError Regexp
+toRegexCI :: Text -> Either RegexError Regexp
-toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s)
+toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt (T.unpack s))  -- Have to unpack here because Text instance in regex-tdfa only appears in 1.3.1
 
 -- | Make a nice error message for a regexp error.
-mkRegexErr :: String -> Maybe a -> Either RegexError a
+mkRegexErr :: Text -> Maybe a -> Either RegexError a
 mkRegexErr s = maybe (Left errmsg) Right
-  where errmsg = "this regular expression could not be compiled: " ++ s
+  where errmsg = T.unpack $ "this regular expression could not be compiled: " <> s
 
 -- Convert a Regexp string to a compiled Regex, throw an error
-toRegex' :: String -> Regexp
+toRegex' :: Text -> Regexp
 toRegex' = either error' id . toRegex
 
 -- Like toRegex', but make a case-insensitive Regex.
-toRegexCI' :: String -> Regexp
+toRegexCI' :: Text -> Regexp
 toRegexCI' = either error' id . toRegexCI
 
 -- | A replacement pattern. May include numeric backreferences (\N).
@@ -159,6 +166,13 @@ type RegexError = String
 regexMatch :: Regexp -> String -> Bool
 regexMatch = matchTest
 
+-- | Tests whether a Regexp matches a Text.
+--
+-- This currently unpacks the Text to a String an works on that. This is due to
+-- a performance bug in regex-tdfa (#9), which may or may not be relevant here.
+regexMatchText :: Regexp -> Text -> Bool
+regexMatchText r = matchTest r . T.unpack
+
 --------------------------------------------------------------------------------
 -- new total functions
 

hledger-lib/Hledger/Utils/String.hs

@@ -38,8 +38,6 @@ module Hledger.Utils.String (
  padright,
  cliptopleft,
  fitto,
- linesPrepend,
- linesPrepend2,
  -- * wide-character-aware layout
  charWidth,
  strWidth,
@@ -55,6 +53,8 @@ module Hledger.Utils.String (
 import Data.Char (isSpace, toLower, toUpper)
 import Data.Default (def)
 import Data.List (intercalate)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
 import Text.Megaparsec ((<|>), between, many, noneOf, sepBy)
 import Text.Megaparsec.Char (char)
 import Text.Printf (printf)
@@ -62,8 +62,8 @@ import Text.Printf (printf)
 import Hledger.Utils.Parse
 import Hledger.Utils.Regex (toRegex', regexReplace)
 import Text.Tabular (Header(..), Properties(..))
-import Text.Tabular.AsciiWide (Align(..), Cell(..), TableOpts(..), renderRow)
+import Text.Tabular.AsciiWide (Align(..), TableOpts(..), alignCell, renderRow)
-import Text.WideString (strWidth, charWidth)
+import Text.WideString (charWidth, strWidth)
 
 
 -- | Take elements from the end of a list.
@@ -184,16 +184,16 @@ unbracket s
 -- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded.
 -- Treats wide characters as double width.
 concatTopPadded :: [String] -> String
-concatTopPadded = renderRow def{tableBorders=False, borderSpaces=False}
+concatTopPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}
                 . Group NoLine . map (Header . cell)
-  where cell = Cell BottomLeft . map (\x -> (x, strWidth x)) . lines
+  where cell = alignCell BottomLeft . T.pack
 
 -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.
 -- Treats wide characters as double width.
 concatBottomPadded :: [String] -> String
-concatBottomPadded = renderRow def{tableBorders=False, borderSpaces=False}
+concatBottomPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}
                    . Group NoLine . map (Header . cell)
-  where cell = Cell TopLeft . map (\x -> (x, strWidth x)) . lines
+  where cell = alignCell TopLeft . T.pack
 
 
 -- | Join multi-line strings horizontally, after compressing each of
@@ -349,15 +349,4 @@ stripAnsi :: String -> String
 stripAnsi s = either err id $ regexReplace ansire "" s
  where
    err    = error "stripAnsi: invalid replacement pattern"      -- PARTIAL, shouldn't happen
-   ansire = toRegex' "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]"  -- PARTIAL, should succeed
+   ansire = toRegex' $ T.pack "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]"  -- PARTIAL, should succeed
-
--- | Add a prefix to each line of a string.
-linesPrepend :: String -> String -> String
-linesPrepend prefix = unlines . map (prefix++) . lines
-
--- | Add a prefix to the first line of a string, 
--- and a different prefix to the remaining lines.
-linesPrepend2 :: String -> String -> String -> String
-linesPrepend2 prefix1 prefix2 s =
-  unlines $ (prefix1++l) : map (prefix2++) ls
-  where l:ls = lines s

hledger-lib/Hledger/Utils/Text.hs

@@ -12,6 +12,8 @@ module Hledger.Utils.Text
  -- underline,
  -- stripbrackets,
   textUnbracket,
+  wrap,
+  textChomp,
  -- -- quoting
   quoteIfSpaced,
   textQuoteIfNeeded,
@@ -29,7 +31,7 @@ module Hledger.Utils.Text
  -- -- * single-line layout
  -- elideLeft,
   textElideRight,
- -- formatString,
+  formatText,
  -- -- * multi-line layout
   textConcatTopPadded,
  -- concatBottomPadded,
@@ -43,7 +45,12 @@ module Hledger.Utils.Text
  -- cliptopleft,
  -- fitto,
   fitText,
+  linesPrepend,
+  linesPrepend2,
  -- -- * wide-character-aware layout
+  WideBuilder(..),
+  wbToText,
+  wbUnpack,
   textWidth,
   textTakeWidth,
  -- fitString,
@@ -70,7 +77,8 @@ import qualified Data.Text as T
 -- import Hledger.Utils.Parse
 -- import Hledger.Utils.Regex
 import Hledger.Utils.Test
-import Text.WideString (charWidth, textWidth)
+import Text.WideString (WideBuilder(..), wbToText, wbUnpack, charWidth, textWidth)
+
 
 -- lowercase, uppercase :: String -> String
 -- lowercase = map toLower
@@ -87,15 +95,23 @@ textElideRight :: Int -> Text -> Text
 textElideRight width t =
     if T.length t > width then T.take (width - 2) t <> ".." else t
 
--- -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.
+-- | Wrap a Text with the surrounding Text.
--- -- Works on multi-line strings too (but will rewrite non-unix line endings).
+wrap :: Text -> Text -> Text -> Text
--- formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String
+wrap start end x = start <> x <> end
--- formatString leftJustified minwidth maxwidth s = intercalate "\n" $ map (printf fmt) $ lines s
+
---     where
+-- | Remove trailing newlines/carriage returns.
---       justify = if leftJustified then "-" else ""
+textChomp :: Text -> Text
---       minwidth' = maybe "" show minwidth
+textChomp = T.dropWhileEnd (`elem` ['\r', '\n'])
---       maxwidth' = maybe "" (("."++).show) maxwidth
+
---       fmt = "%" ++ justify ++ minwidth' ++ maxwidth' ++ "s"
+-- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.
+-- Works on multi-line strings too (but will rewrite non-unix line endings).
+formatText :: Bool -> Maybe Int -> Maybe Int -> Text -> Text
+formatText leftJustified minwidth maxwidth t =
+    T.intercalate "\n" . map (pad . clip) $ if T.null t then [""] else T.lines t
+  where
+    pad  = maybe id justify minwidth
+    clip = maybe id T.take maxwidth
+    justify n = if leftJustified then T.justifyLeft n ' ' else T.justifyRight n ' '
 
 -- underline :: String -> String
 -- underline s = s' ++ replicate (length s) '-' ++ "\n"
@@ -108,7 +124,7 @@ textElideRight width t =
 -- double-quoted.
 quoteIfSpaced :: T.Text -> T.Text
 quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s
-                | not $ any (`elem` (T.unpack s)) whitespacechars = s
+                | not $ any (\c -> T.any (==c) s) whitespacechars = s
                 | otherwise = textQuoteIfNeeded s
 
 -- -- | Wrap a string in double quotes, and \-prefix any embedded single
@@ -122,7 +138,7 @@ quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s
 -- -- | Double-quote this string if it contains whitespace, single quotes
 -- -- or double-quotes, escaping the quotes as needed.
 textQuoteIfNeeded :: T.Text -> T.Text
-textQuoteIfNeeded s | any (`elem` T.unpack s) (quotechars++whitespacechars) = "\"" <> escapeDoubleQuotes s <> "\""
+textQuoteIfNeeded s | any (\c -> T.any (==c) s) (quotechars++whitespacechars) = "\"" <> escapeDoubleQuotes s <> "\""
                     | otherwise = s
 
 -- -- | Single-quote this string if it contains whitespace or double-quotes.
@@ -344,11 +360,22 @@ textTakeWidth w t | not (T.null t),
                 = T.cons c $ textTakeWidth (w-cw) (T.tail t)
               | otherwise = ""
 
+-- | Add a prefix to each line of a string.
+linesPrepend :: Text -> Text -> Text
+linesPrepend prefix = T.unlines . map (prefix<>) . T.lines
+
+-- | Add a prefix to the first line of a string, 
+-- and a different prefix to the remaining lines.
+linesPrepend2 :: Text -> Text -> Text -> Text
+linesPrepend2 prefix1 prefix2 s = T.unlines $ case T.lines s of
+    []   -> []
+    l:ls -> (prefix1<>l) : map (prefix2<>) ls
+
 
 -- | Read a decimal number from a Text. Assumes the input consists only of digit
 -- characters.
 readDecimal :: Text -> Integer
-readDecimal = foldl' step 0 . T.unpack
+readDecimal = T.foldl' step 0
   where step a c = a * 10 + toInteger (digitToInt c)
 
 

hledger-lib/Text/Tabular/AsciiWide.hs

@@ -1,14 +1,25 @@
 -- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat
 -- wide characters as double width.
 
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Text.Tabular.AsciiWide where
 
 import Data.Maybe (fromMaybe)
 import Data.Default (Default(..))
 import Data.List (intersperse, transpose)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
+import Data.Semigroup (stimesMonoid)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText)
 import Safe (maximumMay)
 import Text.Tabular
-import Text.WideString (strWidth)
+import Text.WideString (WideBuilder(..), textWidth)
 
 
 -- | The options to use for rendering a table.
@@ -25,8 +36,7 @@ instance Default TableOpts where
                   }
 
 -- | Cell contents along an alignment
-data Cell = Cell Align [(String, Int)]
+data Cell = Cell Align [WideBuilder]
-    deriving (Show)
 
 -- | How to align text in a cell
 data Align = TopRight | BottomRight | BottomLeft | TopLeft
@@ -36,31 +46,40 @@ emptyCell :: Cell
 emptyCell = Cell TopRight []
 
 -- | Create a single-line cell from the given contents with its natural width.
-alignCell :: Align -> String -> Cell
+alignCell :: Align -> Text -> Cell
-alignCell a x = Cell a [(x, strWidth x)]
+alignCell a x = Cell a . map (\x -> WideBuilder (fromText x) (textWidth x)) $ if T.null x then [""] else T.lines x
 
 -- | Return the width of a Cell.
 cellWidth :: Cell -> Int
-cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map snd xs
+cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map wbWidth xs
 
 
 -- | Render a table according to common options, for backwards compatibility
-render :: Bool -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String
+render :: Bool -> (rh -> Text) -> (ch -> Text) -> (a -> Text) -> Table rh ch a -> TL.Text
 render pretty fr fc f = renderTable def{prettyTable=pretty} (cell . fr) (cell . fc) (cell . f)
   where cell = alignCell TopRight
 
--- | Render a table according to various cell specifications
+-- | Render a table according to various cell specifications>
-renderTable :: TableOpts         -- ^ Options controlling Table rendering
+renderTable :: TableOpts       -- ^ Options controlling Table rendering
             -> (rh -> Cell)  -- ^ Rendering function for row headers
             -> (ch -> Cell)  -- ^ Rendering function for column headers
             -> (a -> Cell)   -- ^ Function determining the string and width of a cell
             -> Table rh ch a
-            -> String
+            -> TL.Text
-renderTable topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) =
+renderTable topts fr fc f = toLazyText . renderTableB topts fr fc f
-  unlines . addBorders $
+
-    renderColumns topts sizes ch2
+-- | A version of renderTable which returns the underlying Builder.
-    : bar VM DoubleLine   -- +======================================+
+renderTableB :: TableOpts       -- ^ Options controlling Table rendering
-    : renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders)
+             -> (rh -> Cell)  -- ^ Rendering function for row headers
+             -> (ch -> Cell)  -- ^ Rendering function for column headers
+             -> (a -> Cell)   -- ^ Function determining the string and width of a cell
+             -> Table rh ch a
+             -> Builder
+renderTableB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) =
+   unlinesB . addBorders $
+     renderColumns topts sizes ch2
+     : bar VM DoubleLine   -- +======================================+
+     : renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders)
  where
   renderR (cs,h) = renderColumns topts sizes $ Group DoubleLine
                      [ Header h
@@ -83,63 +102,68 @@ renderTable topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (T
 
   -- borders and bars
   addBorders xs = if borders then bar VT SingleLine : xs ++ [bar VB SingleLine] else xs
-  bar vpos prop = concat $ renderHLine vpos borders pretty sizes ch2 prop
+  bar vpos prop = mconcat $ renderHLine vpos borders pretty sizes ch2 prop
+  unlinesB = (<>singleton '\n') . mconcat . intersperse "\n"
 
 -- | Render a single row according to cell specifications.
-renderRow :: TableOpts -> Header Cell -> String
+renderRow :: TableOpts -> Header Cell -> TL.Text
-renderRow topts h = renderColumns topts is h
+renderRow topts = toLazyText . renderRowB topts
-  where is = map (\(Cell _ xs) -> fromMaybe 0 . maximumMay $ map snd xs) $ headerContents h
+
+-- | A version of renderRow which returns the underlying Builder.
+renderRowB:: TableOpts -> Header Cell -> Builder
+renderRowB topts h = renderColumns topts is h
+  where is = map cellWidth $ headerContents h
 
 
 verticalBar :: Bool -> Char
 verticalBar pretty = if pretty then '│' else '|'
 
-leftBar :: Bool -> Bool -> String
+leftBar :: Bool -> Bool -> Builder
-leftBar pretty True  = verticalBar pretty : " "
+leftBar pretty True  = fromString $ verticalBar pretty : " "
-leftBar pretty False = [verticalBar pretty]
+leftBar pretty False = singleton $ verticalBar pretty
 
-rightBar :: Bool -> Bool -> String
+rightBar :: Bool -> Bool -> Builder
-rightBar pretty True  = ' ' : [verticalBar pretty]
+rightBar pretty True  = fromString $ ' ' : [verticalBar pretty]
-rightBar pretty False = [verticalBar pretty]
+rightBar pretty False = singleton $ verticalBar pretty
 
-midBar :: Bool -> Bool -> String
+midBar :: Bool -> Bool -> Builder
-midBar pretty True  = ' ' : verticalBar pretty : " "
+midBar pretty True  = fromString $ ' ' : verticalBar pretty : " "
-midBar pretty False = [verticalBar pretty]
+midBar pretty False = singleton $ verticalBar pretty
 
-doubleMidBar :: Bool -> Bool -> String
+doubleMidBar :: Bool -> Bool -> Builder
-doubleMidBar pretty True  = if pretty then " ║ " else " || "
+doubleMidBar pretty True  = fromText $ if pretty then " ║ " else " || "
-doubleMidBar pretty False = if pretty then "║" else "||"
+doubleMidBar pretty False = fromText $ if pretty then "║" else "||"
 
 -- | We stop rendering on the shortest list!
 renderColumns :: TableOpts  -- ^ rendering options for the table
               -> [Int]      -- ^ max width for each column
               -> Header Cell
-              -> String
+              -> Builder
 renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=spaces} is h =
-    concat . intersperse "\n"                    -- Put each line on its own line
+    mconcat . intersperse "\n"                   -- Put each line on its own line
-    . map (addBorders . concat) . transpose      -- Change to a list of lines and add borders
+    . map (addBorders . mconcat) . transpose     -- Change to a list of lines and add borders
     . map (either hsep padCell) . flattenHeader  -- We now have a matrix of strings
     . zipHeader 0 is $ padRow <$> h  -- Pad cell height and add width marker
   where
     -- Pad each cell to have the appropriate width
-    padCell (w, Cell TopLeft     ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls
+    padCell (w, Cell TopLeft     ls) = map (\x -> wbBuilder x <> fromText (T.replicate (w - wbWidth x) " ")) ls
-    padCell (w, Cell BottomLeft  ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls
+    padCell (w, Cell BottomLeft  ls) = map (\x -> wbBuilder x <> fromText (T.replicate (w - wbWidth x) " ")) ls
-    padCell (w, Cell TopRight    ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls
+    padCell (w, Cell TopRight    ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls
-    padCell (w, Cell BottomRight ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls
+    padCell (w, Cell BottomRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls
 
     -- Pad each cell to have the same number of lines
-    padRow (Cell TopLeft     ls) = Cell TopLeft     $ ls ++ replicate (nLines - length ls) ("",0)
+    padRow (Cell TopLeft     ls) = Cell TopLeft     $ ls ++ replicate (nLines - length ls) mempty
-    padRow (Cell TopRight    ls) = Cell TopRight    $ ls ++ replicate (nLines - length ls) ("",0)
+    padRow (Cell TopRight    ls) = Cell TopRight    $ ls ++ replicate (nLines - length ls) mempty
-    padRow (Cell BottomLeft  ls) = Cell BottomLeft  $ replicate (nLines - length ls) ("",0) ++ ls
+    padRow (Cell BottomLeft  ls) = Cell BottomLeft  $ replicate (nLines - length ls) mempty ++ ls
-    padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) ("",0) ++ ls
+    padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) mempty ++ ls
 
-    hsep :: Properties -> [String]
+    hsep :: Properties -> [Builder]
     hsep NoLine     = replicate nLines $ if spaces then "  " else ""
     hsep SingleLine = replicate nLines $ midBar pretty spaces
     hsep DoubleLine = replicate nLines $ doubleMidBar pretty spaces
 
-    addBorders xs | borders   = leftBar pretty spaces ++ xs ++ rightBar pretty spaces
+    addBorders xs | borders   = leftBar pretty spaces <> xs <> rightBar pretty spaces
-                  | spaces    =  ' ' : xs ++ " "
+                  | spaces    = fromText " " <> xs <> fromText " "
                   | otherwise = xs
 
     nLines = fromMaybe 0 . maximumMay . map (\(Cell _ ls) -> length ls) $ headerContents h
@@ -150,52 +174,48 @@ renderHLine :: VPos
             -> [Int] -- ^ width specifications
             -> Header a
             -> Properties
-            -> [String]
+            -> [Builder]
 renderHLine _ _ _ _ _ NoLine = []
 renderHLine vpos borders pretty w h prop = [renderHLine' vpos borders pretty prop w h]
 
-renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String
+renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder
-renderHLine' vpos borders pretty prop is h = addBorders $ sep ++ coreLine ++ sep
+renderHLine' vpos borders pretty prop is h = addBorders $ sep <> coreLine <> sep
  where
-  addBorders xs   = if borders then edge HL ++ xs ++ edge HR else xs
+  addBorders xs   = if borders then edge HL <> xs <> edge HR else xs
   edge hpos       = boxchar vpos hpos SingleLine prop pretty
-  coreLine        = concatMap helper $ flattenHeader $ zipHeader 0 is h
+  coreLine        = foldMap helper $ flattenHeader $ zipHeader 0 is h
   helper          = either vsep dashes
-  dashes (i,_)    = concat (replicate i sep)
+  dashes (i,_)    = stimesMonoid i sep
   sep             = boxchar vpos HM NoLine prop pretty
   vsep v          = case v of
-                      NoLine -> sep ++ sep
+                      NoLine -> sep <> sep
-                      _      -> sep ++ cross v prop ++ sep
+                      _      -> sep <> cross v prop <> sep
   cross v h       = boxchar vpos HM v h pretty
 
 data VPos = VT | VM | VB -- top middle bottom
 data HPos = HL | HM | HR -- left middle right
 
-boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String
+boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> Builder
 boxchar vpos hpos vert horiz = lineart u d l r
   where
-    u =
+    u = case vpos of
-      case vpos of
+          VT -> NoLine
-        VT -> NoLine
+          _  -> vert
-        _  -> vert
+    d = case vpos of
-    d =
+          VB -> NoLine
-      case vpos of
+          _  -> vert
-        VB -> NoLine
+    l = case hpos of
-        _  -> vert
+          HL -> NoLine
-    l =
+          _  -> horiz
-      case hpos of
+    r = case hpos of
-        HL -> NoLine
+          HR -> NoLine
-        _  -> horiz
+          _  -> horiz
-    r =
-      case hpos of
-        HR -> NoLine
-        _  -> horiz
 
-pick :: String -> String -> Bool -> String
+pick :: Text -> Text -> Bool -> Builder
-pick x _ True  = x
+pick x _ True  = fromText x
-pick _ x False = x
+pick _ x False = fromText x
 
-lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> String
+lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> Builder
 --      up         down       left      right
 lineart SingleLine SingleLine SingleLine SingleLine = pick "┼" "+"
 lineart SingleLine SingleLine SingleLine NoLine     = pick "┤" "+"
@@ -244,6 +264,4 @@ lineart NoLine     SingleLine DoubleLine DoubleLine = pick "╤" "+"
 lineart SingleLine SingleLine DoubleLine DoubleLine = pick "╪" "+"
 lineart DoubleLine DoubleLine SingleLine SingleLine = pick "╫" "++"
 
-lineart _          _          _          _          = const ""
+lineart _          _          _          _          = const mempty
-
--- 

hledger-lib/Text/WideString.hs

@@ -1,14 +1,49 @@
 -- | Calculate the width of String and Text, being aware of wide characters.
 
+{-# LANGUAGE CPP #-}
+
 module Text.WideString (
   -- * wide-character-aware layout
   strWidth,
   textWidth,
-  charWidth
+  charWidth,
+  -- * Text Builders which keep track of length
+  WideBuilder(..),
+  wbUnpack,
+  wbToText
   ) where
 
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup (Semigroup(..))
+#endif
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
+
+
+-- | Helper for constructing Builders while keeping track of text width.
+data WideBuilder = WideBuilder
+  { wbBuilder :: !TB.Builder
+  , wbWidth   :: !Int
+  }
+
+instance Semigroup WideBuilder where
+  WideBuilder x i <> WideBuilder y j = WideBuilder (x <> y) (i + j)
+
+instance Monoid WideBuilder where
+  mempty = WideBuilder mempty 0
+#if !(MIN_VERSION_base(4,11,0))
+  mappend = (<>)
+#endif
+
+-- | Convert a WideBuilder to a strict Text.
+wbToText :: WideBuilder -> Text
+wbToText = TL.toStrict . TB.toLazyText . wbBuilder
+
+-- | Convert a WideBuilder to a String.
+wbUnpack :: WideBuilder -> String
+wbUnpack = TL.unpack . TB.toLazyText . wbBuilder
 
 
 -- | Calculate the render width of a string, considering

hledger-lib/hledger-lib.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.33.0.
+-- This file has been generated from package.yaml by hpack version 0.34.2.
 --
 -- see: https://github.com/sol/hpack
 --
@@ -125,7 +125,6 @@ library
     , pretty-simple >4 && <5
     , regex-tdfa
     , safe >=0.2
-    , split >=0.1
     , tabular >=0.2
     , tasty >=1.2.3
     , tasty-hunit >=0.10.0.2
@@ -176,7 +175,6 @@ test-suite doctest
     , pretty-simple >4 && <5
     , regex-tdfa
     , safe >=0.2
-    , split >=0.1
     , tabular >=0.2
     , tasty >=1.2.3
     , tasty-hunit >=0.10.0.2
@@ -229,7 +227,6 @@ test-suite unittest
     , pretty-simple >4 && <5
     , regex-tdfa
     , safe >=0.2
-    , split >=0.1
     , tabular >=0.2
     , tasty >=1.2.3
     , tasty-hunit >=0.10.0.2

hledger-lib/package.yaml

@@ -58,7 +58,6 @@ dependencies:
 - pretty-simple >4 && <5
 - regex-tdfa
 - safe >=0.2
-- split >=0.1
 - tabular >=0.2
 - tasty >=1.2.3
 - tasty-hunit >=0.10.0.2

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -175,7 +175,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
           <+> toggles
           <+> str (" account " ++ if ishistorical then "balances" else "changes")
           <+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
-          <+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
+          <+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
           <+> borderDepthStr mdepth
           <+> str (" ("++curidx++"/"++totidx++")")
           <+> (if ignore_assertions_ $ inputopts_ copts

hledger-ui/Hledger/UI/Main.hs

@@ -141,8 +141,8 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rsp
         where
           acct = headDef (error' $ "--register "++apat++" did not match any account")  -- PARTIAL:
                  . filterAccts $ journalAccountNames j
-          filterAccts = case toRegexCI apat of
+          filterAccts = case toRegexCI $ T.pack apat of
-              Right re -> filter (regexMatch re . T.unpack)
+              Right re -> filter (regexMatchText re)
               Left  _  -> const []
           -- Initialising the accounts screen is awkward, requiring
           -- another temporary UIState value..

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -14,7 +14,6 @@ where
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
 import Data.List
-import Data.List.Split (splitOn)
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Monoid ((<>))
 #endif
@@ -80,7 +79,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec
             ,Not generatedTransactionTag
           ]
 
-    (_label,items) = accountTransactionsReport rspec' j q thisacctq
+    items = accountTransactionsReport rspec' j q thisacctq
     items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $  -- without --empty, exclude no-change txns
              reverse  -- most recent last
              items
@@ -89,17 +88,17 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec
     displayitems = map displayitem items'
       where
         displayitem (t, _, _issplit, otheracctsstr, change, bal) =
-          RegisterScreenItem{rsItemDate          = showDate $ transactionRegisterDate q thisacctq t
+          RegisterScreenItem{rsItemDate          = T.unpack . showDate $ transactionRegisterDate q thisacctq t
                             ,rsItemStatus        = tstatus t
                             ,rsItemDescription   = T.unpack $ tdescription t
-                            ,rsItemOtherAccounts = case splitOn ", " otheracctsstr of
+                            ,rsItemOtherAccounts = T.unpack otheracctsstr
-                                                     [s] -> s
-                                                     ss  -> intercalate ", " ss
                                                      -- _   -> "<split>"  -- should do this if accounts field width < 30
-                            ,rsItemChangeAmount  = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False change
+                            ,rsItemChangeAmount  = showamt change
-                            ,rsItemBalanceAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False bal
+                            ,rsItemBalanceAmount = showamt bal
                             ,rsItemTransaction   = t
                             }
+            where showamt = (\wb -> (wbUnpack wb, wbWidth wb))
+                          . showMixedAmountB oneLine{displayMaxWidth=Just 32}
     -- blank items are added to allow more control of scroll position; we won't allow movement over these.
     -- XXX Ugly. Changing to 0 helps when debugging.
     blankitems = replicate 100  -- "100 ought to be enough for anyone"
@@ -204,7 +203,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
           <+> togglefilters
           <+> str " transactions"
           -- <+> str (if ishistorical then " historical total" else " period total")
-          <+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
+          <+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
           -- <+> str " and subs"
           <+> borderPeriodStr "in" (period_ ropts)
           <+> str " ("

hledger-ui/Hledger/UI/TransactionScreen.hs

@@ -79,9 +79,10 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{
           fromMaybe (error' "TransactionScreen: expected a non-empty journal") $  -- PARTIAL: shouldn't happen
           reportPeriodOrJournalLastDay rspec j
 
-      render $ defaultLayout toplabel bottomlabel $ str $
+      render . defaultLayout toplabel bottomlabel . str
-        showTransactionOneLineAmounts $
+        . T.unpack . showTransactionOneLineAmounts
-        maybe t (transactionApplyValuation prices styles periodlast (rsToday rspec) t) $ value_ ropts
+        . maybe t (transactionApplyValuation prices styles periodlast (rsToday rspec) t)
+        $ value_ ropts
         -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
       where
         toplabel =
@@ -208,7 +209,7 @@ regenerateTransactions rspec j s acct i ui =
   let
     q = filterQuery (not . queryIsDepth) $ rsQuery rspec
     thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs
-    items = reverse $ snd $ accountTransactionsReport rspec j q thisacctq
+    items = reverse $ accountTransactionsReport rspec j q thisacctq
     ts = map first6 items
     numberedts = zip [1..] ts
     -- select the best current transaction from the new list

hledger-ui/Hledger/UI/UIState.hs

@@ -308,7 +308,7 @@ showMinibuffer :: UIState -> UIState
 showMinibuffer ui = setMode (Minibuffer e) ui
   where
     e = applyEdit gotoEOL $ editor MinibufferEditor (Just 1) oldq
-    oldq = unwords . map (quoteIfNeeded . T.unpack)
+    oldq = T.unpack . T.unwords . map textQuoteIfNeeded
          . querystring_ . rsOpts . reportspec_ . cliopts_ $ aopts ui
 
 -- | Close the minibuffer, discarding any edit in progress.

hledger-ui/Hledger/UI/UIUtils.hs

@@ -38,6 +38,7 @@ import Data.List
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Monoid
 #endif
+import qualified Data.Text as T
 import Graphics.Vty
   (Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh
   -- ,Output(displayBounds,mkDisplayContext),DisplayContext(..)
@@ -189,7 +190,7 @@ borderDepthStr (Just d) = str " to depth " <+> withAttr ("border" <> "query") (s
 
 borderPeriodStr :: String -> Period -> Widget Name
 borderPeriodStr _           PeriodAll = str ""
-borderPeriodStr preposition p         = str (" "++preposition++" ") <+> withAttr ("border" <> "query") (str $ showPeriod p)
+borderPeriodStr preposition p         = str (" "++preposition++" ") <+> withAttr ("border" <> "query") (str . T.unpack $ showPeriod p)
 
 borderKeysStr :: [(String,String)] -> Widget Name
 borderKeysStr = borderKeysStr' . map (\(a,b) -> (a, str b))

hledger-web/Hledger/Web/Handler/JournalR.hs

@@ -27,7 +27,7 @@ getJournalR = do
         Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
       title' = title <> if m /= Any then ", filtered" else ""
       acctlink a = (RegisterR, [("q", replaceInacct q $ accountQuery a)])
-      (_, items) = transactionsReport (rsOpts . reportspec_ $ cliopts_ opts) j m
+      items = transactionsReport (rsOpts . reportspec_ $ cliopts_ opts) j m
       transactionFrag = transactionFragment j
 
   defaultLayout $ do

hledger-web/Hledger/Web/Handler/RegisterR.hs

@@ -44,8 +44,11 @@ getRegisterR = do
           zip xs $
           zip (map (T.unpack . accountSummarisedName . paccount) xs) $
           tail $ (", "<$xs) ++ [""]
-      r@(balancelabel,items) = accountTransactionsReport rspec j m acctQuery
+      items = accountTransactionsReport rspec j m acctQuery
-      balancelabel' = if isJust (inAccount qopts) then balancelabel else "Total"
+      balancelabel
+        | isJust (inAccount qopts), balancetype_ (rsOpts rspec) == HistoricalBalance = "Historical Total"
+        | isJust (inAccount qopts) = "Period Total"
+        | otherwise                = "Total"
       transactionFrag = transactionFragment j
   defaultLayout $ do
     setTitle "register - hledger-web"
@@ -96,14 +99,12 @@ decorateLinks =
 
 -- | Generate javascript/html for a register balance line chart based on
 -- the provided "TransactionsReportItem"s.
-registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute
+registerChartHtml :: String -> [(CommoditySymbol, [TransactionsReportItem])] -> HtmlUrl AppRoute
-registerChartHtml percommoditytxnreports = $(hamletFile "templates/chart.hamlet")
+registerChartHtml title percommoditytxnreports = $(hamletFile "templates/chart.hamlet")
  -- have to make sure plot is not called when our container (maincontent)
  -- is hidden, eg with add form toggled
  where
-   charttitle = case maybe "" (fst . snd) $ listToMaybe percommoditytxnreports of
+   charttitle = if null title then "" else title ++ ":"
-     "" -> ""
-     s  -> s <> ":"
    colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex
    commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
    simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts

hledger-web/templates/chart.hamlet

@@ -6,7 +6,7 @@
    if ($chartdiv.is(':visible')) {
      \$('#register-chart-label').text('#{charttitle}');
      var seriesData = [
-      $forall (c,(_,items)) <- percommoditytxnreports
+      $forall (c,items) <- percommoditytxnreports
        /* we render each commodity using two series:
         * one with extra data points added to show a stepped balance line */
        {
@@ -38,7 +38,7 @@
             #{simpleMixedAmountQuantity $ triCommodityBalance c i},
             '#{showMixedAmountWithZeroCommodity $ triCommodityAmount c i}',
             '#{showMixedAmountWithZeroCommodity $ triCommodityBalance c i}',
-            '#{concat $ intersperse "\\n" $ lines  $ showTransaction $ triOrigTransaction i}',
+            '#{concat $ intersperse "\\n" $ lines $ T.unpack $ showTransaction $ triOrigTransaction i}',
             #{tindex $ triOrigTransaction i}
            ],
           /* [] */

hledger-web/templates/register.hamlet

@@ -2,7 +2,7 @@
   #{header}
 
 <div .hidden-xs>
-  ^{registerChartHtml $ transactionsReportByCommodity r}
+  ^{registerChartHtml balancelabel $ transactionsReportByCommodity items}
 
 <div.table-responsive>
   <table .table.table-striped.table-condensed>
@@ -15,7 +15,7 @@
         <th style="text-align:left;">To/From Account(s)
         <th style="text-align:right; white-space:normal;">Amount Out/In
         <th style="text-align:right; white-space:normal;">
-          #{balancelabel'}
+          #{balancelabel}
 
     <tbody>
       $forall (torig, tacct, split, _acct, amt, bal) <- items

hledger/Hledger/Cli/Commands/Add.hs

@@ -27,16 +27,19 @@ import Data.Either (isRight)
 import Data.Functor.Identity (Identity(..))
 import "base-compat-batteries" Data.List.Compat
 import qualified Data.Set as S
-import Data.Maybe
+import Data.Maybe (fromJust, fromMaybe, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
 import Data.Time.Calendar (Day)
 import Data.Time.Format (formatTime, defaultTimeLocale, iso8601DateFormat)
 import Safe (headDef, headMay, atMay)
-import System.Console.CmdArgs.Explicit
+import System.Console.CmdArgs.Explicit (flagNone)
 import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
-import System.Console.Haskeline.Completion
+import System.Console.Haskeline.Completion (CompletionFunc, completeWord, isFinished, noCompletion, simpleCompletion)
-import System.Console.Wizard
+import System.Console.Wizard (Wizard, defaultTo, line, output, retryMsg, linePrewritten, nonEmpty, parser, run)
 import System.Console.Wizard.Haskeline
 import System.IO ( stderr, hPutStr, hPutStrLn )
 import Text.Megaparsec
@@ -89,7 +92,7 @@ add :: CliOpts -> Journal -> IO ()
 add opts j
     | journalFilePath j == "-" = return ()
     | otherwise = do
-        hPrintf stderr "Adding transactions to journal file %s\n" (journalFilePath j)
+        hPutStrLn stderr $ "Adding transactions to journal file " <> journalFilePath j
         showHelp
         today <- getCurrentDay
         let es = defEntryState{esOpts=opts
@@ -123,16 +126,16 @@ getAndAddTransactions es@EntryState{..} = (do
     Nothing -> error "Could not interpret the input, restarting"  -- caught below causing a restart, I believe  -- PARTIAL:
     Just t -> do
       j <- if debug_ esOpts > 0
-           then do hPrintf stderr "Skipping journal add due to debug mode.\n"
+           then do hPutStrLn stderr "Skipping journal add due to debug mode."
                    return esJournal
            else do j' <- journalAddTransaction esJournal esOpts t
-                   hPrintf stderr "Saved.\n"
+                   hPutStrLn stderr "Saved."
                    return j'
-      hPrintf stderr "Starting the next transaction (. or ctrl-D/ctrl-C to quit)\n"
+      hPutStrLn stderr "Starting the next transaction (. or ctrl-D/ctrl-C to quit)"
       getAndAddTransactions es{esJournal=j, esDefDate=tdate t}
   )
   `E.catch` (\(_::RestartTransactionException) ->
-                 hPrintf stderr "Restarting this transaction.\n" >> getAndAddTransactions es)
+                 hPutStrLn stderr "Restarting this transaction." >> getAndAddTransactions es)
 
 data TxnParams = TxnParams
   { txnDate :: Day
@@ -164,7 +167,8 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
             { esArgs = drop 1 esArgs
             , esDefDate = date
             }
-          dateAndCodeString = formatTime defaultTimeLocale yyyymmddFormat date ++ (if T.null code then "" else " (" ++ T.unpack code ++ ")")
+          dateAndCodeString = formatTime defaultTimeLocale yyyymmddFormat date
+                            ++ T.unpack (if T.null code then "" else " (" <> code <> ")")
           yyyymmddFormat = iso8601DateFormat Nothing
       confirmedTransactionWizard prevInput{prevDateAndCode=Just dateAndCodeString} es' (EnterDescAndComment (date, code) : stack)
     Nothing ->
@@ -180,7 +184,9 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
             }
           descAndCommentString = T.unpack $ desc <> (if T.null comment then "" else "  ; " <> comment)
           prevInput' = prevInput{prevDescAndCmnt=Just descAndCommentString}
-      when (isJust mbaset) $ liftIO $ hPrintf stderr "Using this similar transaction for defaults:\n%s" (showTransaction $ fromJust mbaset)
+      when (isJust mbaset) . liftIO $ do
+          hPutStrLn stderr "Using this similar transaction for defaults:"
+          T.hPutStr stderr $ showTransaction (fromJust mbaset)
       confirmedTransactionWizard prevInput' es' ((EnterNewPosting TxnParams{txnDate=date, txnCode=code, txnDesc=desc, txnCmnt=comment} Nothing) : stack)
     Nothing ->
       confirmedTransactionWizard prevInput es (drop 1 stack)
@@ -232,14 +238,14 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
                                ,pcomment=comment
                                ,ptype=accountNamePostingType $ T.pack account
                                }
-          amountAndCommentString = showAmount amount ++ (if T.null comment then "" else "  ;" ++ T.unpack comment)
+          amountAndCommentString = showAmount amount ++ T.unpack (if T.null comment then "" else "  ;" <> comment)
           prevAmountAndCmnt' = replaceNthOrAppend (length esPostings) amountAndCommentString (prevAmountAndCmnt prevInput)
           es' = es{esPostings=esPostings++[posting], esArgs=drop 2 esArgs}
       confirmedTransactionWizard prevInput{prevAmountAndCmnt=prevAmountAndCmnt'} es' (EnterNewPosting txnParams (Just posting) : stack)
     Nothing -> confirmedTransactionWizard prevInput es (drop 1 stack)
 
   EndStage t -> do
-    output $ showTransaction t
+    output . T.unpack $ showTransaction t
     y <- let def = "y" in
          retryMsg "Please enter y or n." $
           parser ((fmap (\c -> if c == '<' then Nothing else Just c)) . headMay . map toLower . strip) $
@@ -262,7 +268,7 @@ similarTransaction EntryState{..} desc =
   in bestmatch
 
 dateAndCodeWizard PrevInput{..} EntryState{..} = do
-  let def = headDef (showDate esDefDate) esArgs
+  let def = headDef (T.unpack $ showDate esDefDate) esArgs
   retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $
    parser (parseSmartDateAndCode esToday) $
    withCompletion (dateCompleter def) $
@@ -303,7 +309,7 @@ accountWizard PrevInput{..} EntryState{..} = do
       historicalp = fmap ((!! (pnum - 1)) . (++ (repeat nullposting)) . tpostings) esSimilarTransaction
       historicalacct = case historicalp of Just p  -> showAccountName Nothing (ptype p) (paccount p)
                                            Nothing -> ""
-      def = headDef historicalacct esArgs
+      def = headDef (T.unpack historicalacct) esArgs
       endmsg | canfinish && null def = " (or . or enter to finish this transaction)"
              | canfinish             = " (or . to finish this transaction)"
              | otherwise             = ""
@@ -367,7 +373,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
       balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings
       balancingamtfirstcommodity = Mixed $ take 1 $ amounts balancingamt
       showamt =
-        showMixedAmountWithPrecision
+        showMixedAmount . setMixedAmountPrecision
                   -- what should this be ?
                   -- 1 maxprecision (show all decimal places or none) ?
                   -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ?
@@ -442,7 +448,7 @@ journalAddTransaction j@Journal{jtxns=ts} opts t = do
     -- unelided shows all amounts explicitly, in case there's a price, cf #283
   when (debug_ opts > 0) $ do
     putStrLn $ printf "\nAdded transaction to %s:" f
-    putStrLn =<< registerFromString (showTransaction t)
+    TL.putStrLn =<< registerFromString (showTransaction t)
   return j{jtxns=ts++[t]}
 
 -- | Append a string, typically one or more transactions, to a journal
@@ -453,20 +459,20 @@ journalAddTransaction j@Journal{jtxns=ts} opts t = do
 -- even if the file uses dos line endings (\r\n), which could leave
 -- mixed line endings in the file. See also writeFileWithBackupIfChanged.
 --
-appendToJournalFileOrStdout :: FilePath -> String -> IO ()
+appendToJournalFileOrStdout :: FilePath -> Text -> IO ()
 appendToJournalFileOrStdout f s
-  | f == "-"  = putStr s'
+  | f == "-"  = T.putStr s'
-  | otherwise = appendFile f s'
+  | otherwise = appendFile f $ T.unpack s'
-  where s' = "\n" ++ ensureOneNewlineTerminated s
+  where s' = "\n" <> ensureOneNewlineTerminated s
 
 -- | Replace a string's 0 or more terminating newlines with exactly one.
-ensureOneNewlineTerminated :: String -> String
+ensureOneNewlineTerminated :: Text -> Text
-ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse
+ensureOneNewlineTerminated = (<>"\n") . T.dropWhileEnd (=='\n')
 
 -- | Convert a string of journal data into a register report.
-registerFromString :: String -> IO String
+registerFromString :: T.Text -> IO TL.Text
 registerFromString s = do
-  j <- readJournal' $ T.pack s
+  j <- readJournal' s
   return . postingsReportAsText opts $ postingsReport rspec j
       where
         ropts = defreportopts{empty_=True}

hledger/Hledger/Cli/Commands/Aregister.hs

@@ -19,18 +19,14 @@ module Hledger.Cli.Commands.Aregister (
  ,tests_Aregister
 ) where
 
-import Data.Aeson (toJSON)
+import Data.List (intersperse)
-import Data.Aeson.Text (encodeToLazyText)
+import Data.Maybe (fromMaybe, isJust)
-import Data.List
-import Data.Maybe
-#if !(MIN_VERSION_base(4,11,0))
-import Data.Semigroup ((<>))
-#endif
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
 import Data.Time (addDays)
 import Safe (headDef)
-import System.Console.CmdArgs.Explicit
+import System.Console.CmdArgs.Explicit (flagNone, flagReq)
 import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
 
 import Hledger
@@ -81,8 +77,8 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
   let
     acct = headDef (error' $ show apat++" did not match any account")   -- PARTIAL:
            . filterAccts $ journalAccountNames j
-    filterAccts = case toRegexCI apat of
+    filterAccts = case toRegexCI $ T.pack apat of
-        Right re -> filter (regexMatch re . T.unpack)
+        Right re -> filter (regexMatchText re)
         Left  _  -> const []
     -- gather report options
     inclusive = True  -- tree_ ropts
@@ -109,21 +105,21 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
           ]
     -- run the report
     -- TODO: need to also pass the queries so we can choose which date to render - move them into the report ?
-    (balancelabel,items) = accountTransactionsReport rspec' j reportq thisacctq
+    items = accountTransactionsReport rspec' j reportq thisacctq
     items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $
              reverse items
     -- select renderer
-    render | fmt=="json" = (++"\n") . T.unpack . TL.toStrict . encodeToLazyText . toJSON
+    render | fmt=="txt"  = accountTransactionsReportAsText opts reportq thisacctq
-           | fmt=="csv"  = (++"\n") . printCSV . accountTransactionsReportAsCsv reportq thisacctq
+           | fmt=="csv"  = printCSV . accountTransactionsReportAsCsv reportq thisacctq
-           | fmt=="txt"  = accountTransactionsReportAsText opts reportq thisacctq
+           | fmt=="json" = toJsonText
-           | otherwise   = const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
+           | otherwise   = error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
       where
         fmt = outputFormatFromOpts opts
 
-  writeOutput opts $ render (balancelabel,items')
+  writeOutputLazyText opts $ render items'
 
 accountTransactionsReportAsCsv :: Query -> Query -> AccountTransactionsReport -> CSV
-accountTransactionsReportAsCsv reportq thisacctq (_,is) =
+accountTransactionsReportAsCsv reportq thisacctq is =
   ["txnidx","date","code","description","otheraccounts","change","balance"]
   : map (accountTransactionsReportItemAsCsvRecord reportq thisacctq) is
 
@@ -131,34 +127,32 @@ accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransaction
 accountTransactionsReportItemAsCsvRecord
   reportq thisacctq
   (t@Transaction{tindex,tcode,tdescription}, _, _issplit, otheracctsstr, change, balance)
-  = [idx,date,code,desc,otheracctsstr,amt,bal]
+  = [idx,date,tcode,tdescription,otheracctsstr,amt,bal]
   where
-    idx  = show tindex
+    idx  = T.pack $ show tindex
     date = showDate $ transactionRegisterDate reportq thisacctq t
-    code = T.unpack tcode
+    amt  = wbToText $ showMixedAmountB oneLine change
-    desc = T.unpack tdescription
+    bal  = wbToText $ showMixedAmountB oneLine balance
-    amt  = showMixedAmountOneLineWithoutPrice False change
-    bal  = showMixedAmountOneLineWithoutPrice False balance
 
 -- | Render a register report as plain text suitable for console output.
-accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> String
+accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text
-accountTransactionsReportAsText
+accountTransactionsReportAsText copts reportq thisacctq items
-  copts@CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{no_elide_}}} reportq thisacctq (_balancelabel,items)
+  = TB.toLazyText . mconcat . intersperse (TB.fromText "\n") $
-  = unlines $ title :
+    title :
     map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items
   where
-    amtwidth = maximumStrict $ 12 : map (snd . showamt . itemamt) items
+    amtwidth = maximumStrict $ 12 : map (wbWidth . showamt . itemamt) items
-    balwidth = maximumStrict $ 12 : map (snd . showamt . itembal) items
+    balwidth = maximumStrict $ 12 : map (wbWidth . showamt . itembal) items
-    showamt = showMixedOneLine showAmountWithoutPrice (Just 12) mmax False  -- color_
+    showamt = showMixedAmountB oneLine{displayMinWidth=Just 12, displayMaxWidth=mmax}  -- color_
-      where mmax = if no_elide_ then Nothing else Just 32
+      where mmax = if no_elide_ . rsOpts . reportspec_ $ copts then Nothing else Just 32
     itemamt (_,_,_,_,a,_) = a
     itembal (_,_,_,_,_,a) = a
     -- show a title indicating which account was picked, which can be confusing otherwise
-    title = T.unpack $ maybe "" (("Transactions in "<>).(<>" and subaccounts:")) macct
+    title = maybe mempty (\s -> foldMap TB.fromText ["Transactions in ", s, " and subaccounts:"]) macct
       where
         -- XXX temporary hack ? recover the account name from the query
         macct = case filterQuery queryIsAcct thisacctq of
-                  Acct r -> Just . T.drop 1 . T.dropEnd 5 . T.pack $ reString r  -- Acct "^JS:expenses(:|$)"
+                  Acct r -> Just . T.drop 1 . T.dropEnd 5 $ reString r  -- Acct "^JS:expenses(:|$)"
                   _      -> Nothing  -- shouldn't happen
 
 -- | Render one account register report line item as plain text. Layout is like so:
@@ -173,72 +167,64 @@ accountTransactionsReportAsText
 -- Returns a string which can be multi-line, eg if the running balance
 -- has multiple commodities.
 --
-accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> String
+accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> TB.Builder
 accountTransactionsReportItemAsText
   copts@CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{color_}}}
   reportq thisacctq preferredamtwidth preferredbalwidth
-  (t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance)
+  (t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance) =
     -- Transaction -- the transaction, unmodified
     -- Transaction -- the transaction, as seen from the current account
     -- Bool        -- is this a split (more than one posting to other accounts) ?
     -- String      -- a display string describing the other account(s), if any
     -- MixedAmount -- the amount posted to the current account(s) (or total amount posted)
     -- MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction
+    foldMap TB.fromText . concat . intersperse (["\n"]) $
+      [ fitText (Just datewidth) (Just datewidth) True True date
+      , " "
+      , fitText (Just descwidth) (Just descwidth) True True tdescription
+      , "  "
+      , fitText (Just acctwidth) (Just acctwidth) True True accts
+      , "  "
+      , amtfirstline
+      , "  "
+      , balfirstline
+      ]
+      :
+      [ [ spacer, a, "  ", b ] | (a,b) <- zip amtrest balrest ]
+  where
+    -- calculate widths
+    (totalwidth,mdescwidth) = registerWidthsFromOpts copts
+    (datewidth, date) = (10, showDate $ transactionRegisterDate reportq thisacctq t)
+    (amtwidth, balwidth)
+      | shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
+      | otherwise      = (adjustedamtwidth, adjustedbalwidth)
+      where
+        mincolwidth = 2 -- columns always show at least an ellipsis
+        maxamtswidth = max 0 (totalwidth - (datewidth + 1 + mincolwidth + 2 + mincolwidth + 2 + 2))
+        shortfall = (preferredamtwidth + preferredbalwidth) - maxamtswidth
+        amtwidthproportion = fromIntegral preferredamtwidth / fromIntegral (preferredamtwidth + preferredbalwidth)
+        adjustedamtwidth = round $ amtwidthproportion * fromIntegral maxamtswidth
+        adjustedbalwidth = maxamtswidth - adjustedamtwidth
 
-  = intercalate "\n" $
+    remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
-    concat [fitString (Just datewidth) (Just datewidth) True True date
+    (descwidth, acctwidth) = (w, remaining - 2 - w)
-           ," "
+      where w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
-           ,fitString (Just descwidth) (Just descwidth) True True desc
-           ,"  "
-           ,fitString (Just acctwidth) (Just acctwidth) True True accts
-           ,"  "
-           ,amtfirstline
-           ,"  "
-           ,balfirstline
-           ]
-    :
-    [concat [spacer
-            ,a
-            ,"  "
-            ,b
-            ]
-     | (a,b) <- zip amtrest balrest
-     ]
-    where
-      -- calculate widths
-      (totalwidth,mdescwidth) = registerWidthsFromOpts copts
-      (datewidth, date) = (10, showDate $ transactionRegisterDate reportq thisacctq t)
-      (amtwidth, balwidth)
-        | shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
-        | otherwise      = (adjustedamtwidth, adjustedbalwidth)
-        where
-          mincolwidth = 2 -- columns always show at least an ellipsis
-          maxamtswidth = max 0 (totalwidth - (datewidth + 1 + mincolwidth + 2 + mincolwidth + 2 + 2))
-          shortfall = (preferredamtwidth + preferredbalwidth) - maxamtswidth
-          amtwidthproportion = fromIntegral preferredamtwidth / fromIntegral (preferredamtwidth + preferredbalwidth)
-          adjustedamtwidth = round $ amtwidthproportion * fromIntegral maxamtswidth
-          adjustedbalwidth = maxamtswidth - adjustedamtwidth
 
-      remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
+    -- gather content
-      (descwidth, acctwidth) = (w, remaining - 2 - w)
+    accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
-        where
+            otheracctsstr
-          w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
+    amt = TL.toStrict . TB.toLazyText . wbBuilder $ showamt amtwidth change
-
+    bal = TL.toStrict . TB.toLazyText . wbBuilder $ showamt balwidth balance
-      -- gather content
+    showamt w = showMixedAmountB noPrice{displayColour=color_, displayMinWidth=Just w, displayMaxWidth=Just w}
-      desc = T.unpack tdescription
+    -- alternate behaviour, show null amounts as 0 instead of blank
-      accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
+    -- amt = if null amt' then "0" else amt'
-              otheracctsstr
+    -- bal = if null bal' then "0" else bal'
-      amt = fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just balwidth) color_ change
+    (amtlines, ballines) = (T.lines amt, T.lines bal)
-      bal = fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) color_ balance
+    (amtlen, ballen) = (length amtlines, length ballines)
-      -- alternate behaviour, show null amounts as 0 instead of blank
+    numlines = max 1 (max amtlen ballen)
-      -- amt = if null amt' then "0" else amt'
+    (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat "" -- posting amount is top-aligned
-      -- bal = if null bal' then "0" else bal'
+    (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned
-      (amtlines, ballines) = (lines amt, lines bal)
+    spacer = T.replicate (totalwidth - (amtwidth + 2 + balwidth)) " "
-      (amtlen, ballen) = (length amtlines, length ballines)
-      numlines = max 1 (max amtlen ballen)
-      (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat (replicate amtwidth ' ') -- posting amount is top-aligned
-      (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) (replicate balwidth ' ') ++ ballines -- balance amount is bottom-aligned
-      spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' '
 
 -- tests
 

hledger/Hledger/Cli/Commands/Balance.hs

@@ -255,7 +255,7 @@ module Hledger.Cli.Commands.Balance (
 ) where
 
 import Data.Default (def)
-import Data.List (intercalate, transpose)
+import Data.List (intersperse, transpose)
 import Data.Maybe (fromMaybe, maybeToList)
 --import qualified Data.Map as Map
 #if !(MIN_VERSION_base(4,11,0))
@@ -263,11 +263,12 @@ import Data.Semigroup ((<>))
 #endif
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
 import Data.Time (fromGregorian)
 import System.Console.CmdArgs.Explicit as C
 import Lucid as L
-import Text.Tabular as T
+import Text.Tabular as Tab
-import Text.Tabular.AsciiWide as T
+import Text.Tabular.AsciiWide as Tab
 
 import Hledger
 import Hledger.Cli.CliOptions
@@ -321,30 +322,30 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
               assrt = not $ ignore_assertions_ $ inputopts_ opts
           render = case fmt of
             "txt"  -> budgetReportAsText ropts
-            "json" -> (++"\n") . TL.unpack . toJsonText
+            "json" -> (<>"\n") . toJsonText
-            "csv"  -> (++"\n") . printCSV . budgetReportAsCsv ropts
+            "csv"  -> printCSV . budgetReportAsCsv ropts
-            _      -> const $ error' $ unsupportedOutputFormatError fmt
+            _      -> error' $ unsupportedOutputFormatError fmt
-      writeOutput opts $ render budgetreport
+      writeOutputLazyText opts $ render budgetreport
 
     else
       if multiperiod then do  -- multi period balance report
         let report = multiBalanceReport rspec j
             render = case fmt of
               "txt"  -> multiBalanceReportAsText ropts
-              "csv"  -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts
+              "csv"  -> printCSV . multiBalanceReportAsCsv ropts
-              "html" -> (++"\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts
+              "html" -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts
-              "json" -> (++"\n") . TL.unpack . toJsonText
+              "json" -> (<>"\n") . toJsonText
               _      -> const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
-        writeOutput opts $ render report
+        writeOutputLazyText opts $ render report
 
       else do  -- single period simple balance report
         let report = balanceReport rspec j -- simple Ledger-style balance report
             render = case fmt of
-              "txt"  -> balanceReportAsText
+              "txt"  -> \ropts -> TB.toLazyText . balanceReportAsText ropts
-              "csv"  -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
+              "csv"  -> \ropts -> printCSV . balanceReportAsCsv ropts
-              "json" -> const $ (++"\n") . TL.unpack . toJsonText
+              "json" -> const $ (<>"\n") . toJsonText
-              _      -> const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
+              _      -> error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
-        writeOutput opts $ render ropts report
+        writeOutputLazyText opts $ render ropts report
 
 
 -- XXX should all the per-report, per-format rendering code live in the command module,
@@ -356,25 +357,32 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
 balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
 balanceReportAsCsv opts (items, total) =
   ["account","balance"] :
-  [[T.unpack a, showMixedAmountOneLineWithoutPrice False b] | (a, _, _, b) <- items]
+  [[a, wbToText $ showMixedAmountB oneLine b] | (a, _, _, b) <- items]
   ++
   if no_total_ opts
   then []
-  else [["total", showMixedAmountOneLineWithoutPrice False total]]
+  else [["total", wbToText $ showMixedAmountB oneLine total]]
 
 -- | Render a single-column balance report as plain text.
-balanceReportAsText :: ReportOpts -> BalanceReport -> String
+balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
-balanceReportAsText opts ((items, total)) = unlines $
+balanceReportAsText opts ((items, total)) =
-    concat lines ++ if no_total_ opts then [] else overline : totallines
+    unlinesB lines
+    <> unlinesB (if no_total_ opts then [] else [overline, totalLines])
   where
-    lines = map (balanceReportItemAsText opts) items
+    unlinesB [] = mempty
+    unlinesB xs = mconcat (intersperse (TB.singleton '\n') xs) <> TB.singleton '\n'
+
+    (lines, sizes) = unzip $ map (balanceReportItemAsText opts) items
     -- abuse renderBalanceReportItem to render the total with similar format
-    acctcolwidth = maximum' [T.length fullname | (fullname, _, _, _) <- items]
+    (totalLines, _) = renderBalanceReportItem opts ("",0,total)
-    totallines = map rstrip $ renderBalanceReportItem opts (T.replicate (acctcolwidth+1) " ", 0, total)
     -- with a custom format, extend the line to the full report width;
     -- otherwise show the usual 20-char line for compatibility
-    overlinewidth = fromMaybe (maximum' . map length $ concat lines) . overlineWidth $ format_ opts
+    overlinewidth = case format_ opts of
-    overline   = replicate overlinewidth '-'
+        OneLine       ((FormatField _ _ _ TotalField):_) -> 20
+        TopAligned    ((FormatField _ _ _ TotalField):_) -> 20
+        BottomAligned ((FormatField _ _ _ TotalField):_) -> 20
+        _ -> sum (map maximum' $ transpose sizes)
+    overline   = TB.fromText $ T.replicate overlinewidth "-"
 
 {-
 :r
@@ -391,7 +399,7 @@ This implementation turned out to be a bit convoluted but implements the followi
 -- whatever string format is specified). Note, prices will not be rendered, and
 -- differently-priced quantities of the same commodity will appear merged.
 -- The output will be one or more lines depending on the format and number of commodities.
-balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> [String]
+balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (TB.Builder, [Int])
 balanceReportItemAsText opts (_, accountName, depth, amt) =
   renderBalanceReportItem opts (
     accountName,
@@ -400,42 +408,37 @@ balanceReportItemAsText opts (_, accountName, depth, amt) =
     )
 
 -- | Render a balance report item using the given StringFormat, generating one or more lines of text.
-renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> [String]
+renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int])
 renderBalanceReportItem opts (acctname, depth, total) =
-  lines $ case format_ opts of
+  case format_ opts of
-      OneLine       _ comps -> concatOneLine      $ render1 comps
+      OneLine       comps -> renderRow' $ render True  True  comps
-      TopAligned    _ comps -> concatBottomPadded $ render comps
+      TopAligned    comps -> renderRow' $ render True  False comps
-      BottomAligned _ comps -> concatTopPadded    $ render comps
+      BottomAligned comps -> renderRow' $ render False False comps
   where
-    render1 = map (renderComponent1 opts (acctname, depth, total))
+    renderRow' is = ( renderRowB def{tableBorders=False, borderSpaces=False}
-    render  = map (renderComponent opts (acctname, depth, total))
+                      . Tab.Group NoLine $ map Header is
+                    , map cellWidth is )
+
+    render topaligned oneline = map (maybeConcat . renderComponent topaligned opts (acctname, depth, total))
+      where maybeConcat (Cell a xs) =
+                if oneline then Cell a [WideBuilder (mconcat . intersperse (TB.fromText ", ") $ map wbBuilder xs) width]
+                           else Cell a xs
+              where width = sumStrict (map ((+2) . wbWidth) xs) -2
+
 
 -- | Render one StringFormat component for a balance report item.
-renderComponent :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
+renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell
-renderComponent _ _ (FormatLiteral s) = s
+renderComponent _ _ _ (FormatLiteral s) = alignCell TopLeft s
-renderComponent opts (acctname, depth, total) (FormatField ljust min max field) = case field of
+renderComponent topaligned opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of
-  DepthSpacerField -> formatString ljust Nothing max $ replicate d ' '
+    DepthSpacerField -> Cell align [WideBuilder (TB.fromText $ T.replicate d " ") d]
-                      where d = case min of
+                        where d = maybe id min mmax $ depth * fromMaybe 1 mmin
-                                 Just m  -> depth * m
+    AccountField     -> alignCell align $ formatText ljust mmin mmax acctname
-                                 Nothing -> depth
+    TotalField       -> Cell align . pure $ showamt total
-  AccountField     -> formatString ljust min max (T.unpack acctname)
+    _                -> Cell align [mempty]
-  TotalField       -> fst $ showMixed showAmountWithoutPrice min max (color_ opts) total
+  where
-  _                -> ""
+    align = if topaligned then (if ljust then TopLeft    else TopRight)
-
+                          else (if ljust then BottomLeft else BottomRight)
--- | Render one StringFormat component for a balance report item.
+    showamt = showMixedAmountB noPrice{displayColour=color_ opts, displayMinWidth=mmin, displayMaxWidth=mmax}
--- This variant is for use with OneLine string formats; it squashes
--- any multi-line rendered values onto one line, comma-and-space separated,
--- while still complying with the width spec.
-renderComponent1 :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
-renderComponent1 _ _ (FormatLiteral s) = s
-renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field) = case field of
-  AccountField     -> formatString ljust min max ((intercalate ", " . lines) (indented (T.unpack acctname)))
-                      where
-                        -- better to indent the account name here rather than use a DepthField component
-                        -- so that it complies with width spec. Uses a fixed indent step size.
-                        indented = ((replicate (depth*2) ' ')++)
-  TotalField       -> fst $ showMixedOneLine showAmountWithoutPrice min max (color_ opts) total
-  _                -> ""
 
 -- rendering multi-column balance reports
 
@@ -450,8 +453,8 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
    ++ ["Total"   | row_total_]
    ++ ["Average" | average_]
   ) :
-  [T.unpack (displayFull a) :
+  [displayFull a :
-   map (showMixedAmountOneLineWithoutPrice False)
+   map (wbToText . showMixedAmountB oneLine)
    (amts
     ++ [rowtot | row_total_]
     ++ [rowavg | average_])
@@ -460,7 +463,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
   if no_total_ opts
   then []
   else ["Total:" :
-        map (showMixedAmountOneLineWithoutPrice False) (
+        map (wbToText . showMixedAmountB oneLine) (
           coltotals
           ++ [tot | row_total_]
           ++ [avg | average_]
@@ -496,7 +499,7 @@ multiBalanceReportHtmlRows ropts mbr =
     )
 
 -- | Render one MultiBalanceReport heading row as a HTML table row.
-multiBalanceReportHtmlHeadRow :: ReportOpts -> [String] -> Html ()
+multiBalanceReportHtmlHeadRow :: ReportOpts -> [T.Text] -> Html ()
 multiBalanceReportHtmlHeadRow _ [] = mempty  -- shouldn't happen
 multiBalanceReportHtmlHeadRow ropts (acct:rest) =
   let
@@ -514,7 +517,7 @@ multiBalanceReportHtmlHeadRow ropts (acct:rest) =
       ++ [td_ [class_ "rowaverage", defstyle] (toHtml a) | a <- avg]
 
 -- | Render one MultiBalanceReport data row as a HTML table row.
-multiBalanceReportHtmlBodyRow :: ReportOpts -> [String] -> Html ()
+multiBalanceReportHtmlBodyRow :: ReportOpts -> [T.Text] -> Html ()
 multiBalanceReportHtmlBodyRow _ [] = mempty  -- shouldn't happen
 multiBalanceReportHtmlBodyRow ropts (label:rest) =
   let
@@ -532,7 +535,7 @@ multiBalanceReportHtmlBodyRow ropts (label:rest) =
       ++ [td_ [class_ "amount rowaverage", defstyle] (toHtml a) | a <- avg]
 
 -- | Render one MultiBalanceReport totals row as a HTML table row.
-multiBalanceReportHtmlFootRow :: ReportOpts -> [String] -> Html ()
+multiBalanceReportHtmlFootRow :: ReportOpts -> [T.Text] -> Html ()
 multiBalanceReportHtmlFootRow _ropts [] = mempty
 -- TODO pad totals row with zeros when subreport is empty
 --  multiBalanceReportHtmlFootRow ropts $
@@ -559,9 +562,11 @@ multiBalanceReportHtmlFootRow ropts (acct:rest) =
 --thRow = tr_ . mconcat . map (th_ . toHtml)
 
 -- | Render a multi-column balance report as plain text suitable for console output.
-multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
+multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> TL.Text
-multiBalanceReportAsText ropts@ReportOpts{..} r =
+multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $
-    title ++ "\n\n" ++ (balanceReportTableAsText ropts $ balanceReportAsTable ropts r)
+    TB.fromText title
+    <> TB.fromText "\n\n"
+    <> balanceReportTableAsText ropts (balanceReportAsTable ropts r)
   where
     title = mtitle <> " in " <> showDateSpan (periodicReportSpan r) <> valuationdesc <> ":"
 
@@ -576,7 +581,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r =
         Just (AtEnd _mc) | changingValuation -> ""
         Just (AtEnd _mc)     -> ", valued at period ends"
         Just (AtNow _mc)     -> ", current value"
-        Just (AtDate d _mc)  -> ", valued at "++showDate d
+        Just (AtDate d _mc)  -> ", valued at " <> showDate d
         Nothing              -> ""
 
     changingValuation = case (balancetype_, value_) of
@@ -584,14 +589,14 @@ multiBalanceReportAsText ropts@ReportOpts{..} r =
         _                              -> False
 
 -- | Build a 'Table' from a multi-column balance report.
-balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
+balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text MixedAmount
 balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
     (PeriodicReport spans items (PeriodicReportRow _ coltotals tot avg)) =
    maybetranspose $
    addtotalrow $
    Table
-     (T.Group NoLine $ map Header accts)
+     (Tab.Group NoLine $ map Header accts)
-     (T.Group NoLine $ map Header colheadings)
+     (Tab.Group NoLine $ map Header colheadings)
      (map rowvals items)
   where
     totalscolumn = row_total_ && balancetype_ `notElem` [CumulativeChange, HistoricalBalance]
@@ -600,7 +605,7 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
                   ++ ["Average" | average_]
     accts = map renderacct items
     renderacct row =
-        replicate ((prrDepth row - 1) * 2) ' ' ++ T.unpack (prrDisplayName row)
+        T.replicate ((prrDepth row - 1) * 2) " " <> prrDisplayName row
     rowvals (PeriodicReportRow _ as rowtot rowavg) = as
                              ++ [rowtot | totalscolumn]
                              ++ [rowavg | average_]
@@ -617,12 +622,12 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
 -- made using 'balanceReportAsTable'), render it in a format suitable for
 -- console output. Amounts with more than two commodities will be elided
 -- unless --no-elide is used.
-balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String
+balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text MixedAmount -> TB.Builder
 balanceReportTableAsText ReportOpts{..} =
-    T.renderTable def{tableBorders=False, prettyTable=pretty_tables_}
+    Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_}
-        (T.alignCell TopLeft) (T.alignCell TopRight) showamt
+        (Tab.alignCell TopLeft) (Tab.alignCell TopRight) showamt
   where
-    showamt = Cell TopRight . pure . showMixedOneLine showAmountWithoutPrice Nothing mmax color_
+    showamt = Cell TopRight . pure . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=mmax}
     mmax = if no_elide_ then Nothing else Just 32
 
 
@@ -631,14 +636,12 @@ tests_Balance = tests "Balance" [
    tests "balanceReportAsText" [
     test "unicode in balance layout" $ do
       j <- readJournal' "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
-      let rspec = defreportspec
+      let rspec = defreportspec{rsOpts=defreportopts{no_total_=True}}
-      balanceReportAsText (rsOpts rspec) (balanceReport rspec{rsToday=fromGregorian 2008 11 26} j)
+      TB.toLazyText (balanceReportAsText (rsOpts rspec) (balanceReport rspec{rsToday=fromGregorian 2008 11 26} j))
         @?=
-        unlines
+        TL.unlines
         ["                -100  актив:наличные"
         ,"                 100  расходы:покупки"
-        ,"--------------------"
-        ,"                   0"
         ]
     ]
 

hledger/Hledger/Cli/Commands/Balancesheet.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
 {-|
 
 The @balancesheet@ command prints a simple balance sheet.

hledger/Hledger/Cli/Commands/Balancesheetequity.hs

@@ -1,5 +1,7 @@
-{-# LANGUAGE QuasiQuotes, RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
 {-|
 
 The @balancesheetequity@ command prints a simple balance sheet.

hledger/Hledger/Cli/Commands/Cashflow.hs

@@ -1,5 +1,7 @@
-{-# LANGUAGE QuasiQuotes, RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
 {-|
 
 The @cashflow@ command prints a simplified cashflow statement.  It just

hledger/Hledger/Cli/Commands/Check/Ordereddates.hs

@@ -1,11 +1,16 @@
+{-# LANGUAGE CPP #-}
+
 module Hledger.Cli.Commands.Check.Ordereddates (
   journalCheckOrdereddates
 )
 where
 
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
+import qualified Data.Text as T
 import Hledger
 import Hledger.Cli.CliOptions
-import Text.Printf
 
 journalCheckOrdereddates :: CliOpts -> Journal -> Either String ()
 journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
@@ -22,16 +27,16 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
     FoldAcc{fa_previous=Nothing} -> return ()
     FoldAcc{fa_error=Nothing}    -> return ()
     FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
-      let 
+      let
+        datestr = if date2_ ropts then "2" else ""
         uniquestr = if checkunique then " and/or not unique" else ""
         positionstr = showGenericSourcePos $ tsourcepos error
-        txn1str = linesPrepend  "  "      $ showTransaction previous
+        txn1str = T.unpack . linesPrepend  (T.pack "  ")               $ showTransaction previous
-        txn2str = linesPrepend2 "> " "  " $ showTransaction error
+        txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack "  ") $ showTransaction error
-      Left $ printf "transaction date%s is out of order%s\nat %s:\n\n%s"
+      Left $
-        (if date2_ ropts then "2" else "")
+        "Error: transaction date" <> datestr <> " is out of order"
-        uniquestr
+        <> uniquestr <> "\nat " <> positionstr <> ":\n\n"
-        positionstr
+        <> txn1str <> txn2str
-        (txn1str ++ txn2str)
 
 data FoldAcc a b = FoldAcc
  { fa_error    :: Maybe a

hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs

@@ -1,26 +1,32 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Hledger.Cli.Commands.Check.Uniqueleafnames (
   journalCheckUniqueleafnames
 )
 where
 
-import Data.Function
+import Data.Function (on)
-import Data.List
+import Data.List (groupBy, sortBy)
 import Data.List.Extra (nubSort)
+import Data.Text (Text)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
 import qualified Data.Text as T
 import Hledger
-import Text.Printf
 
 journalCheckUniqueleafnames :: Journal -> Either String ()
 journalCheckUniqueleafnames j = do
   let dupes = checkdupes' $ accountsNames j
   if null dupes
   then Right ()
-  else Left $ 
+  else Left . T.unpack $
     -- XXX make output more like Checkdates.hs, Check.hs etc.
-    concatMap render dupes
+    foldMap render dupes
     where
-      render (leafName, accountNameL) = 
+      render (leafName, accountNameL) =
-        printf "%s as %s\n" leafName (intercalate ", " (map T.unpack accountNameL))
+        leafName <> " as " <> T.intercalate ", " accountNameL
 
 checkdupes' :: (Ord k, Eq k) => [(k, v)] -> [(k, [v])]
 checkdupes' l = zip dupLeafs dupAccountNames
@@ -31,8 +37,8 @@ checkdupes' l = zip dupLeafs dupAccountNames
           . groupBy ((==) `on` fst)
           . sortBy (compare `on` fst)
 
-accountsNames :: Journal -> [(String, AccountName)]
+accountsNames :: Journal -> [(Text, AccountName)]
 accountsNames j = map leafAndAccountName as
-  where leafAndAccountName a = (T.unpack $ accountLeafName a, a)
+  where leafAndAccountName a = (accountLeafName a, a)
         ps = journalPostings j
         as = nubSort $ map paccount ps

hledger/Hledger/Cli/Commands/Checkdates.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE NoOverloadedStrings #-} -- prevent trouble if turned on in ghci
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Hledger.Cli.Commands.Checkdates (
+  checkdatesmode
+ ,checkdates
+) where
+
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Hledger
+import Hledger.Cli.CliOptions
+import System.Console.CmdArgs.Explicit
+import System.Exit
+
+checkdatesmode :: Mode RawOpts
+checkdatesmode = hledgerCommandMode
+  $(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt")
+  [flagNone ["unique"] (setboolopt "unique") "require that dates are unique"]
+  [generalflagsgroup1]
+  hiddenflags
+  ([], Just $ argsFlag "[QUERY]")
+
+checkdates :: CliOpts -> Journal -> IO ()
+checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
+  let ropts = (rsOpts rspec){accountlistmode_=ALFlat}
+  let ts = filter (rsQuery rspec `matchesTransaction`) $
+           jtxns $ journalSelectingAmountFromOpts ropts j
+  -- pprint rawopts
+  let unique = boolopt "--unique" rawopts  -- TEMP: it's this for hledger check dates
+            || boolopt "unique" rawopts    -- and this for hledger check-dates (for some reason)
+  let date = transactionDateFn ropts
+  let compare a b =
+        if unique
+        then date a <  date b
+        else date a <= date b
+  case checkTransactions compare ts of
+    FoldAcc{fa_previous=Nothing} -> return ()
+    FoldAcc{fa_error=Nothing}    -> return ()
+    FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
+      let
+        uniquestr = T.pack $ if unique then " and/or not unique" else ""
+        positionstr = T.pack . showGenericSourcePos $ tsourcepos error
+        txn1str = linesPrepend  (T.pack "  ")               $ showTransaction previous
+        txn2str = linesPrepend2 (T.pack "> ") (T.pack "  ") $ showTransaction error
+      T.putStrLn $
+        T.pack "Error: transaction date is out of order"
+        <> uniquestr <> T.pack "\nat " <> positionstr <> T.pack ":\n\n"
+        <> txn1str <> txn2str
+      exitFailure
+
+data FoldAcc a b = FoldAcc
+ { fa_error    :: Maybe a
+ , fa_previous :: Maybe b
+ }
+
+foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b
+foldWhile _ acc [] = acc
+foldWhile fold acc (a:as) =
+  case fold a acc of
+   acc@FoldAcc{fa_error=Just _} -> acc
+   acc -> foldWhile fold acc as
+
+checkTransactions :: (Transaction -> Transaction -> Bool)
+ -> [Transaction] -> FoldAcc Transaction Transaction
+checkTransactions compare = foldWhile f FoldAcc{fa_error=Nothing, fa_previous=Nothing}
+  where
+    f current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}
+    f current acc@FoldAcc{fa_previous=Just previous} =
+      if compare previous current
+      then acc{fa_previous=Just current}
+      else acc{fa_error=Just current}

hledger/Hledger/Cli/Commands/Close.hs

@@ -10,9 +10,10 @@ where
 import Control.Monad (when)
 import Data.Function (on)
 import Data.List (groupBy)
-import Data.Maybe
+import Data.Maybe (fromMaybe)
-import qualified Data.Text as T (pack)
+import qualified Data.Text as T
-import Data.Time.Calendar
+import qualified Data.Text.IO as T
+import Data.Time.Calendar (addDays)
 import System.Console.CmdArgs.Explicit as C
 
 import Hledger
@@ -152,6 +153,5 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
       ++ [posting{paccount=openingacct, pamount=if explicit then mapMixedAmount precise (negate totalamt) else missingmixedamt} | not interleaved]
 
   -- print them
-  when closing $ putStr $ showTransaction closingtxn
+  when closing . T.putStr $ showTransaction closingtxn
-  when opening $ putStr $ showTransaction openingtxn
+  when opening . T.putStr $ showTransaction openingtxn
-

hledger/Hledger/Cli/Commands/Diff.hs

@@ -12,14 +12,14 @@ module Hledger.Cli.Commands.Diff (
  ,diff
 ) where
 
-import Data.List
+import Data.List ((\\), groupBy, nubBy, sortBy)
-import Data.Function
+import Data.Function (on)
-import Data.Ord
+import Data.Ord (comparing)
-import Data.Maybe
+import Data.Maybe (fromJust)
-import Data.Time
+import Data.Time (diffDays)
-import Data.Either
+import Data.Either (partitionEithers)
-import qualified Data.Text as T
+import qualified Data.Text.IO as T
-import System.Exit
+import System.Exit (exitFailure)
 
 import Hledger
 import Prelude hiding (putStrLn)
@@ -106,7 +106,7 @@ diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{rsQuery=Acct acctRe}} _ = do
   j1 <- readJournalFile' f1
   j2 <- readJournalFile' f2
 
-  let acct = T.pack $ reString acctRe
+  let acct = reString acctRe
   let pp1 = matchingPostings acct j1
   let pp2 = matchingPostings acct j2
 
@@ -116,10 +116,10 @@ diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{rsQuery=Acct acctRe}} _ = do
   let unmatchedtxn2 = unmatchedtxns R pp2 m
 
   putStrLn "These transactions are in the first file only:\n"
-  mapM_ (putStr . showTransaction) unmatchedtxn1
+  mapM_ (T.putStr . showTransaction) unmatchedtxn1
 
   putStrLn "These transactions are in the second file only:\n"
-  mapM_ (putStr . showTransaction) unmatchedtxn2
+  mapM_ (T.putStr . showTransaction) unmatchedtxn2
 
 diff _ _ = do
   putStrLn "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME"

hledger/Hledger/Cli/Commands/Files.hs

@@ -4,7 +4,6 @@ The @files@ command lists included files.
 
 -}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Hledger.Cli.Commands.Files (
@@ -12,8 +11,8 @@ module Hledger.Cli.Commands.Files (
  ,files
 ) where
 
-import Data.List
+import qualified Data.Text as T
-import Safe
+import Safe (headMay)
 
 import Hledger
 import Prelude hiding (putStrLn)
@@ -33,7 +32,7 @@ filesmode = hledgerCommandMode
 files :: CliOpts -> Journal -> IO ()
 files CliOpts{rawopts_=rawopts} j = do
   let args = listofstringopt "args" rawopts
-  regex <- mapM (either fail pure . toRegex) $ headMay args
+  regex <- mapM (either fail pure . toRegex . T.pack) $ headMay args
   let files = maybe id (filter . regexMatch) regex
               $ map fst
               $ jfiles j

hledger/Hledger/Cli/Commands/Import.hs

@@ -9,6 +9,7 @@ where
 
 import Control.Monad
 import Data.List
+import qualified Data.Text.IO as T
 import Hledger
 import Hledger.Cli.CliOptions
 import Hledger.Cli.Commands.Add (journalAddTransaction)
@@ -50,7 +51,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do
               printf "; would import %d new transactions from %s:\n\n" (length newts) inputstr
               -- TODO how to force output here ?
               -- length (jtxns newj) `seq` print' opts{rawopts_=("explicit",""):rawopts} newj
-              mapM_ (putStr . showTransaction) newts
+              mapM_ (T.putStr . showTransaction) newts
             newts | catchup -> do
               printf "marked %s as caught up, skipping %d unimported transactions\n\n" inputstr (length newts)
             newts -> do

hledger/Hledger/Cli/Commands/Prices.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module Hledger.Cli.Commands.Prices (
   pricesmode
@@ -10,6 +11,7 @@ import qualified Data.Map as M
 import Data.Maybe
 import Data.List
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Data.Time
 import Hledger
 import Hledger.Cli.CliOptions
@@ -33,7 +35,7 @@ prices opts j = do
     cprices    = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps
     icprices   = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts $ mapAmount invertPrice ps
     allprices  = mprices ++ ifBoolOpt "costs" cprices ++ ifBoolOpt "inverted-costs" icprices
-  mapM_ (putStrLn . showPriceDirective) $
+  mapM_ (T.putStrLn . showPriceDirective) $
     sortOn pddate $
     filter (matchesPriceDirective q) $
     allprices
@@ -41,8 +43,8 @@ prices opts j = do
     ifBoolOpt opt | boolopt opt $ rawopts_ opts = id
                   | otherwise = const []
 
-showPriceDirective :: PriceDirective -> String
+showPriceDirective :: PriceDirective -> T.Text
-showPriceDirective mp = unwords ["P", show $ pddate mp, T.unpack . quoteCommoditySymbolIfNeeded $ pdcommodity mp, showAmountWithZeroCommodity $ pdamount mp]
+showPriceDirective mp = T.unwords ["P", T.pack . show $ pddate mp, quoteCommoditySymbolIfNeeded $ pdcommodity mp, wbToText . showAmountB noColour{displayZeroCommodity=True} $ pdamount mp]
 
 divideAmount' :: Quantity -> Amount -> Amount
 divideAmount' n a = a' where

hledger/Hledger/Cli/Commands/Print.hs

@@ -4,8 +4,9 @@ A ledger-compatible @print@ command.
 
 -}
 
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module Hledger.Cli.Commands.Print (
   printmode
@@ -17,9 +18,14 @@ where
 
 import Data.Maybe (isJust)
 import Data.Text (Text)
-import Data.List (intercalate)
+import Data.List (intersperse)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
 import System.Console.CmdArgs.Explicit
 import Hledger.Read.CsvReader (CSV, printCSV)
 
@@ -53,18 +59,18 @@ print' opts j = do
     Just desc -> printMatch opts j $ T.pack desc
 
 printEntries :: CliOpts -> Journal -> IO ()
-printEntries opts@CliOpts{reportspec_=rspec} j = do
+printEntries opts@CliOpts{reportspec_=rspec} j =
-  let fmt = outputFormatFromOpts opts
+    writeOutputLazyText opts . render $ entriesReport rspec j
-      render = case fmt of
+  where
-        "txt"  -> entriesReportAsText opts
+    fmt = outputFormatFromOpts opts
-        "csv"  -> (++"\n") . printCSV . entriesReportAsCsv
+    render | fmt=="txt"  = entriesReportAsText opts
-        "json" -> (++"\n") . TL.unpack . toJsonText
+           | fmt=="csv"  = printCSV . entriesReportAsCsv
-        "sql"  -> entriesReportAsSql
+           | fmt=="json" = toJsonText
-        _      -> const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
+           | fmt=="sql"  = entriesReportAsSql
-  writeOutput opts $ render $ entriesReport rspec j
+           | otherwise   = error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
 
-entriesReportAsText :: CliOpts -> EntriesReport -> String
+entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text
-entriesReportAsText opts = concatMap (showTransaction . whichtxn)
+entriesReportAsText opts = TB.toLazyText . foldMap (TB.fromText . showTransaction . whichtxn)
   where
     whichtxn
       -- With -x, use the fully-inferred txn with all amounts & txn prices explicit.
@@ -125,18 +131,17 @@ originalPostingPreservingAccount p = (originalPosting p) { paccount = paccount p
 --       ]
 --  ]
 
-entriesReportAsSql :: EntriesReport -> String
+entriesReportAsSql :: EntriesReport -> TL.Text
-entriesReportAsSql txns =
+entriesReportAsSql txns = TB.toLazyText $ mconcat
-  "create table if not exists postings(id serial,txnidx int,date1 date,date2 date,status text,code text,description text,comment text,account text,amount numeric,commodity text,credit numeric,debit numeric,posting_status text,posting_comment text);\n"++
+    [ TB.fromText "create table if not exists postings(id serial,txnidx int,date1 date,date2 date,status text,code text,description text,comment text,account text,amount numeric,commodity text,credit numeric,debit numeric,posting_status text,posting_comment text);\n"
-  "insert into postings(txnidx,date1,date2,status,code,description,comment,account,amount,commodity,credit,debit,posting_status,posting_comment) values\n"++
+    , TB.fromText "insert into postings(txnidx,date1,date2,status,code,description,comment,account,amount,commodity,credit,debit,posting_status,posting_comment) values\n"
-  (intercalate "," (map values csv))
+    , mconcat . intersperse (TB.fromText ",") $ map values csv
-  ++";\n"
+    , TB.fromText ";\n"
+    ]
   where
-    values vs = "(" ++ (intercalate "," $ map toSql vs) ++ ")\n"
+    values vs = TB.fromText "(" <> mconcat (intersperse (TB.fromText ",") $ map toSql vs) <> TB.fromText ")\n"
-    toSql "" = "NULL"
+    toSql "" = TB.fromText "NULL"
-    toSql s  = "'" ++ (concatMap quoteChar s) ++ "'"
+    toSql s  = TB.fromText "'" <> TB.fromText (T.replace "'" "''" s) <> TB.fromText "'"
-    quoteChar '\'' = "''"
-    quoteChar c = [c]
     csv = concatMap transactionToCSV txns
 
 entriesReportAsCsv :: EntriesReport -> CSV
@@ -148,16 +153,16 @@ entriesReportAsCsv txns =
 -- The txnidx field (transaction index) allows postings to be grouped back into transactions.
 transactionToCSV :: Transaction -> CSV
 transactionToCSV t =
-  map (\p -> show idx:date:date2:status:code:description:comment:p)
+  map (\p -> T.pack (show idx):date:date2:status:code:description:comment:p)
    (concatMap postingToCSV $ tpostings t)
   where
     idx = tindex t
-    description = T.unpack $ tdescription t
+    description = tdescription t
     date = showDate (tdate t)
-    date2 = maybe "" showDate (tdate2 t)
+    date2 = maybe "" showDate $ tdate2 t
-    status = show $ tstatus t
+    status = T.pack . show $ tstatus t
-    code = T.unpack $ tcode t
+    code = tcode t
-    comment = chomp $ strip $ T.unpack $ tcomment t
+    comment = T.strip $ tcomment t
 
 postingToCSV :: Posting -> CSV
 postingToCSV p =
@@ -165,17 +170,17 @@ postingToCSV p =
     -- commodity goes into separate column, so we suppress it, along with digit group
     -- separators and prices
     let a_ = a{acommodity="",astyle=(astyle a){asdigitgroups=Nothing},aprice=Nothing} in
-    let amount = showAmount a_ in
+    let showamt = TL.toStrict . TB.toLazyText . wbBuilder . showAmountB noColour in
-    let commodity = T.unpack c in
+    let amount = showamt a_ in
-    let credit = if q < 0 then showAmount $ negate a_ else "" in
+    let credit = if q < 0 then showamt $ negate a_ else "" in
-    let debit  = if q >= 0 then showAmount a_ else "" in
+    let debit  = if q >= 0 then showamt a_ else "" in
-    [account, amount, commodity, credit, debit, status, comment])
+    [account, amount, c, credit, debit, status, comment])
    amounts
   where
     Mixed amounts = pamount p
-    status = show $ pstatus p
+    status = T.pack . show $ pstatus p
     account = showAccountName Nothing (ptype p) (paccount p)
-    comment = chomp $ strip $ T.unpack $ pcomment p
+    comment = T.strip $ pcomment p
 
 -- --match
 
@@ -185,7 +190,7 @@ printMatch :: CliOpts -> Journal -> Text -> IO ()
 printMatch CliOpts{reportspec_=rspec} j desc = do
   case similarTransaction' j (rsQuery rspec) desc of
       Nothing -> putStrLn "no matches found."
-      Just t  -> putStr $ showTransaction t
+      Just t  -> T.putStr $ showTransaction t
 
   where
     -- Identify the closest recent match for this description in past transactions.

hledger/Hledger/Cli/Commands/Register.hs

@@ -4,10 +4,10 @@ A ledger-compatible @register@ command.
 
 -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards   #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module Hledger.Cli.Commands.Register (
   registermode
@@ -18,11 +18,15 @@ module Hledger.Cli.Commands.Register (
  ,tests_Register
 ) where
 
-import Data.List
+import Data.List (intersperse)
-import Data.Maybe
+import Data.Maybe (fromMaybe, isJust)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
 -- import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
 import System.Console.CmdArgs.Explicit
 import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
 
@@ -58,16 +62,17 @@ registermode = hledgerCommandMode
 
 -- | Print a (posting) register report.
 register :: CliOpts -> Journal -> IO ()
-register opts@CliOpts{reportspec_=rspec} j = do
+register opts@CliOpts{reportspec_=rspec} j =
-  let fmt = outputFormatFromOpts opts
+    writeOutputLazyText opts . render $ postingsReport rspec j
-      render | fmt=="txt"  = postingsReportAsText
+  where
-             | fmt=="csv"  = const ((++"\n") . printCSV . postingsReportAsCsv)
+    fmt = outputFormatFromOpts opts
-             | fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
+    render | fmt=="txt"  = postingsReportAsText opts
-             | otherwise   = const $ error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
+           | fmt=="csv"  = printCSV . postingsReportAsCsv
-  writeOutput opts . render opts $ postingsReport rspec j
+           | fmt=="json" = toJsonText
+           | otherwise   = error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
 
 postingsReportAsCsv :: PostingsReport -> CSV
-postingsReportAsCsv (_,is) =
+postingsReportAsCsv is =
   ["txnidx","date","code","description","account","amount","total"]
   :
   map postingsReportItemAsCsvRecord is
@@ -75,27 +80,32 @@ postingsReportAsCsv (_,is) =
 postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
 postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal]
   where
-    idx  = show $ maybe 0 tindex $ ptransaction p
+    idx  = T.pack . show . maybe 0 tindex $ ptransaction p
     date = showDate $ postingDate p -- XXX csv should show date2 with --date2
-    code = maybe "" (T.unpack . tcode) $ ptransaction p
+    code = maybe "" tcode $ ptransaction p
-    desc = T.unpack $ maybe "" tdescription $ ptransaction p
+    desc = maybe "" tdescription $ ptransaction p
-    acct = bracket $ T.unpack $ paccount p
+    acct = bracket $ paccount p
       where
         bracket = case ptype p of
-                             BalancedVirtualPosting -> (\s -> "["++s++"]")
+                             BalancedVirtualPosting -> wrap "[" "]"
-                             VirtualPosting -> (\s -> "("++s++")")
+                             VirtualPosting -> wrap "(" ")"
                              _ -> id
-    amt = showMixedAmountOneLineWithoutPrice False $ pamount p
+    amt = wbToText . showMixedAmountB oneLine $ pamount p
-    bal = showMixedAmountOneLineWithoutPrice False b
+    bal = wbToText $ showMixedAmountB oneLine b
 
 -- | Render a register report as plain text suitable for console output.
-postingsReportAsText :: CliOpts -> PostingsReport -> String
+postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
-postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText opts amtwidth balwidth) items
+postingsReportAsText opts items =
+    TB.toLazyText . unlinesB $
+      map (postingsReportItemAsText opts amtwidth balwidth) items
   where
-    amtwidth = maximumStrict $ map (snd . showMixed showAmount (Just 12) Nothing False . itemamt) items
+    amtwidth = maximumStrict $ map (wbWidth . showAmt . itemamt) items
-    balwidth = maximumStrict $ map (snd . showMixed showAmount (Just 12) Nothing False . itembal) items
+    balwidth = maximumStrict $ map (wbWidth . showAmt . itembal) items
     itemamt (_,_,_,Posting{pamount=a},_) = a
     itembal (_,_,_,_,a) = a
+    unlinesB [] = mempty
+    unlinesB xs = mconcat (intersperse (TB.fromText "\n") xs) <> TB.fromText "\n"
+    showAmt = showMixedAmountB noColour{displayMinWidth=Just 12}
 
 -- | Render one register report line item as plain text. Layout is like so:
 -- @
@@ -119,29 +129,23 @@ postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText op
 -- has multiple commodities. Does not yet support formatting control
 -- like balance reports.
 --
-postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> String
+postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> TB.Builder
 postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) =
   -- use elide*Width to be wide-char-aware
   -- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $
-  intercalate "\n" $
+  foldMap TB.fromText . concat . intersperse (["\n"]) $
-    concat [fitString (Just datewidth) (Just datewidth) True True date
+    [ fitText (Just datewidth) (Just datewidth) True True date
-           ," "
+    , " "
-           ,fitString (Just descwidth) (Just descwidth) True True desc
+    , fitText (Just descwidth) (Just descwidth) True True desc
-           ,"  "
+    , "  "
-           ,fitString (Just acctwidth) (Just acctwidth) True True acct
+    , fitText (Just acctwidth) (Just acctwidth) True True acct
-           ,"  "
+    , "  "
-           ,amtfirstline
+    , amtfirstline
-           ,"  "
+    , "  "
-           ,balfirstline
+    , balfirstline
-           ]
+    ]
     :
-    [concat [spacer
+    [ [ spacer, a, "  ", b ] | (a,b) <- zip amtrest balrest ]
-            ,a
-            ,"  "
-            ,b
-            ]
-     | (a,b) <- zip amtrest balrest
-     ]
     where
       -- calculate widths
       (totalwidth,mdescwidth) = registerWidthsFromOpts opts
@@ -171,24 +175,26 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
 
       -- gather content
       desc = fromMaybe "" mdesc
-      acct = parenthesise $ T.unpack $ elideAccountName awidth $ paccount p
+      acct = parenthesise . elideAccountName awidth $ paccount p
          where
           (parenthesise, awidth) =
             case ptype p of
-              BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)
+              BalancedVirtualPosting -> (\s -> wrap "[" "]" s, acctwidth-2)
-              VirtualPosting         -> (\s -> "("++s++")", acctwidth-2)
+              VirtualPosting         -> (\s -> wrap "(" ")" s, acctwidth-2)
               _                      -> (id,acctwidth)
-      amt = fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just amtwidth) (color_ . rsOpts $ reportspec_ opts) $ pamount p
+          wrap a b x = a <> x <> b
-      bal = fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) (color_ . rsOpts $ reportspec_ opts) b
+      amt = TL.toStrict . TB.toLazyText . wbBuilder . showamt amtwidth $ pamount p
+      bal = TL.toStrict . TB.toLazyText . wbBuilder $ showamt balwidth b
+      showamt w = showMixedAmountB noPrice{displayColour=color_ . rsOpts $ reportspec_ opts, displayMinWidth=Just w, displayMaxWidth=Just w}
       -- alternate behaviour, show null amounts as 0 instead of blank
       -- amt = if null amt' then "0" else amt'
       -- bal = if null bal' then "0" else bal'
-      (amtlines, ballines) = (lines amt, lines bal)
+      (amtlines, ballines) = (T.lines amt, T.lines bal)
       (amtlen, ballen) = (length amtlines, length ballines)
       numlines = max 1 (max amtlen ballen)
-      (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat (replicate amtwidth ' ') -- posting amount is top-aligned
+      (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat (T.replicate amtwidth " ") -- posting amount is top-aligned
-      (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) (replicate balwidth ' ') ++ ballines -- balance amount is bottom-aligned
+      (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) (T.replicate balwidth " ") ++ ballines -- balance amount is bottom-aligned
-      spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' '
+      spacer = T.replicate (totalwidth - (amtwidth + 2 + balwidth)) " "
 
 -- tests
 
@@ -198,7 +204,7 @@ tests_Register = tests "Register" [
     test "unicode in register layout" $ do
       j <- readJournal' "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
       let rspec = defreportspec
-      (postingsReportAsText defcliopts $ postingsReport rspec j)
+      (TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec j)
         @?=
         unlines
         ["2009-01-01 медвежья шкура       расходы:покупки                100           100"

hledger/Hledger/Cli/Commands/Registermatch.hs

@@ -10,6 +10,7 @@ where
 import Data.Char (toUpper)
 import Data.List
 import qualified Data.Text as T
+import qualified Data.Text.Lazy.IO as TL
 import Hledger
 import Hledger.Cli.CliOptions
 import Hledger.Cli.Commands.Register
@@ -25,14 +26,13 @@ registermatch :: CliOpts -> Journal -> IO ()
 registermatch opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j =
   case listofstringopt "args" rawopts of
     [desc] -> do
-        let (_,pris) = postingsReport rspec j
+        let ps = [p | (_,_,_,p,_) <- postingsReport rspec j]
-            ps = [p | (_,_,_,p,_) <- pris]
         case similarPosting ps desc of
           Nothing -> putStrLn "no matches found."
-          Just p  -> putStr $ postingsReportAsText opts ("",[pri])
+          Just p  -> TL.putStr $ postingsReportAsText opts [pri]
                      where pri = (Just (postingDate p)
                                  ,Nothing
-                                 ,Just $ T.unpack (maybe "" tdescription $ ptransaction p)
+                                 ,tdescription <$> ptransaction p
                                  ,p
                                  ,0)
     _ -> putStrLn "please provide one description argument."

hledger/Hledger/Cli/Commands/Rewrite.hs

@@ -13,7 +13,9 @@ import Control.Monad.Writer hiding (Any)
 #endif
 import Data.Functor.Identity
 import Data.List (sortOn, foldl')
+import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Hledger
 import Hledger.Cli.CliOptions
 import Hledger.Cli.Commands.Print
@@ -65,9 +67,9 @@ printOrDiff opts
 diffOutput :: Journal -> Journal -> IO ()
 diffOutput j j' = do
     let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t']
-    putStr $ renderPatch $ map (uncurry $ diffTxn j) changed
+    T.putStr $ renderPatch $ map (uncurry $ diffTxn j) changed
 
-type Chunk = (GenericSourcePos, [DiffLine String])
+type Chunk = (GenericSourcePos, [DiffLine Text])
 
 -- XXX doctests, update needed:
 -- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.First "x", D.Second "y"])]
@@ -95,17 +97,17 @@ type Chunk = (GenericSourcePos, [DiffLine String])
 -- @@ -5,0 +5,1 @@
 -- +z
 -- | Render list of changed lines as a unified diff
-renderPatch :: [Chunk] -> String
+renderPatch :: [Chunk] -> Text
 renderPatch = go Nothing . sortOn fst where
     go _ [] = ""
-    go Nothing cs@((sourceFilePath -> fp, _):_) = fileHeader fp ++ go (Just (fp, 0)) cs
+    go Nothing cs@((sourceFilePath -> fp, _):_) = fileHeader fp <> go (Just (fp, 0)) cs
     go (Just (fp, _)) cs@((sourceFilePath -> fp', _):_) | fp /= fp' = go Nothing cs
-    go (Just (fp, offs)) ((sourceFirstLine -> lineno, diffs):cs) = chunkHeader ++ chunk ++ go (Just (fp, offs + adds - dels)) cs
+    go (Just (fp, offs)) ((sourceFirstLine -> lineno, diffs):cs) = chunkHeader <> chunk <> go (Just (fp, offs + adds - dels)) cs
         where
-            chunkHeader = printf "@@ -%d,%d +%d,%d @@\n" lineno dels (lineno+offs) adds where
+            chunkHeader = T.pack $ printf "@@ -%d,%d +%d,%d @@\n" lineno dels (lineno+offs) adds where
             (dels, adds) = foldl' countDiff (0, 0) diffs
-            chunk = concatMap renderLine diffs
+            chunk = foldMap renderLine diffs
-    fileHeader fp = printf "--- %s\n+++ %s\n" fp fp
+    fileHeader fp = "--- " <> T.pack fp <> "\n+++ " <> T.pack fp <> "\n"
 
     countDiff (dels, adds) = \case
         Del _  -> (dels + 1, adds)
@@ -113,9 +115,9 @@ renderPatch = go Nothing . sortOn fst where
         Ctx _ -> (dels + 1, adds + 1)
 
     renderLine = \case
-        Del s -> '-' : s ++ "\n"
+        Del s -> "-" <> s <> "\n"
-        Add s -> '+' : s ++ "\n"
+        Add s -> "+" <> s <> "\n"
-        Ctx s -> ' ' : s ++ "\n"
+        Ctx s -> " " <> s <> "\n"
 
 diffTxn :: Journal -> Transaction -> Transaction -> Chunk
 diffTxn j t t' =
@@ -124,18 +126,18 @@ diffTxn j t t' =
                 -- TODO: use range and produce two chunks: one removes part of
                 --       original file, other adds transaction to new file with
                 --       suffix .ledger (generated). I.e. move transaction from one file to another.
-                diffs :: [DiffLine String]
+                diffs :: [DiffLine Text]
                 diffs = concat . map (traverse showPostingLines . mapDiff) $ D.getDiff (tpostings t) (tpostings t')
             pos@(JournalSourcePos fp (line, line')) -> (pos, diffs) where
                 -- We do diff for original lines vs generated ones. Often leads
                 -- to big diff because of re-format effect.
-                diffs :: [DiffLine String]
+                diffs :: [DiffLine Text]
                 diffs = map mapDiff $ D.getDiff source changed'
-                source | Just contents <- lookup fp $ jfiles j = map T.unpack . drop (line-1) . take line' $ T.lines contents
+                source | Just contents <- lookup fp $ jfiles j = drop (line-1) . take line' $ T.lines contents
                        | otherwise = []
-                changed = lines $ showTransaction t'
+                changed = T.lines $ showTransaction t'
                 changed' | null changed = changed
-                         | null $ last changed = init changed
+                         | T.null $ last changed = init changed
                          | otherwise = changed
 
 data DiffLine a = Del a | Add a | Ctx a

hledger/Hledger/Cli/Commands/Roi.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE ParallelListComp #-}
+{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell  #-}
+{-# LANGUAGE ParallelListComp  #-}
+{-# LANGUAGE TemplateHaskell   #-}
 {-|
 
 The @roi@ command prints internal rate of return and time-weighted rate of return for and investment.
@@ -20,6 +21,7 @@ import Data.List
 import Numeric.RootFinding
 import Data.Decimal
 import qualified Data.Text as T
+import qualified Data.Text.Lazy.IO as TL
 import System.Console.CmdArgs.Explicit as CmdArgs
 
 import Text.Tabular as Tbl
@@ -118,22 +120,22 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
     let smallIsZero x = if abs x < 0.01 then 0.0 else x
     return [ showDate spanBegin
            , showDate (addDays (-1) spanEnd)
-           , show valueBefore
+           , T.pack $ show valueBefore
-           , show cashFlowAmt
+           , T.pack $ show cashFlowAmt
-           , show valueAfter
+           , T.pack $ show valueAfter
-           , show (valueAfter - (valueBefore + cashFlowAmt))
+           , T.pack $ show (valueAfter - (valueBefore + cashFlowAmt))
-           , printf "%0.2f%%" $ smallIsZero irr
+           , T.pack $ printf "%0.2f%%" $ smallIsZero irr
-           , printf "%0.2f%%" $ smallIsZero twr ]
+           , T.pack $ printf "%0.2f%%" $ smallIsZero twr ]
 
   let table = Table
-              (Tbl.Group NoLine (map (Header . show) (take (length tableBody) [1..])))
+              (Tbl.Group NoLine (map (Header . T.pack . show) (take (length tableBody) [1..])))
               (Tbl.Group DoubleLine
                [ Tbl.Group SingleLine [Header "Begin", Header "End"]
                , Tbl.Group SingleLine [Header "Value (begin)", Header "Cashflow", Header "Value (end)", Header "PnL"]
                , Tbl.Group SingleLine [Header "IRR", Header "TWR"]])
               tableBody
 
-  putStrLn $ Ascii.render prettyTables id id id table
+  TL.putStrLn $ Ascii.render prettyTables id id id table
 
 timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow pnl) = do
   let initialUnitPrice = 100
@@ -196,7 +198,7 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spa
         unitBalances = add initialUnits unitBalances'
         valuesOnDate = add 0 valuesOnDate'
 
-    putStr $ Ascii.render prettyTables id id id
+    TL.putStr $ Ascii.render prettyTables id id T.pack
       (Table
        (Tbl.Group NoLine (map (Header . showDate) dates))
        (Tbl.Group DoubleLine [ Tbl.Group SingleLine [Header "Portfolio value", Header "Unit balance"]
@@ -226,11 +228,11 @@ internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueB
   when showCashFlow $ do
     printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
     let (dates, amounts) = unzip totalCF
-    putStrLn $ Ascii.render prettyTables id id id
+    TL.putStrLn $ Ascii.render prettyTables id id id
       (Table
        (Tbl.Group NoLine (map (Header . showDate) dates))
        (Tbl.Group SingleLine [Header "Amount"])
-       (map ((:[]) . show) amounts))
+       (map ((:[]) . T.pack . show) amounts))
 
   -- 0% is always a solution, so require at least something here
   case totalCF of

hledger/Hledger/Cli/Commands/Tags.hs

@@ -29,7 +29,7 @@ tags :: CliOpts -> Journal -> IO ()
 tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
   d <- getCurrentDay
   let args = listofstringopt "args" rawopts
-  mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args
+  mtagpat <- mapM (either Fail.fail pure . toRegexCI . T.pack) $ headMay args
   let
     querystring = map T.pack $ drop 1 args
     values      = boolopt "values" rawopts
@@ -44,7 +44,7 @@ tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
       (if parsed then id else nubSort)
       [ r
       | (t,v) <- concatMap transactionAllTags txns
-      , maybe True (`regexMatch` T.unpack t) mtagpat
+      , maybe True (`regexMatchText` t) mtagpat
       , let r = if values then v else t
       , not (values && T.null v && not empty)
       ]

hledger/Hledger/Cli/CompoundBalanceCommand.hs

@@ -1,4 +1,7 @@
-{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
 {-|
 
 Common helpers for making multi-section balance report commands
@@ -13,19 +16,23 @@ module Hledger.Cli.CompoundBalanceCommand (
 ) where
 
 import Data.List (foldl')
-import Data.Maybe
+import Data.Maybe (fromMaybe, mapMaybe)
-import qualified Data.Text as TS
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
+import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
-import Data.Time.Calendar
+import qualified Data.Text.Lazy.Builder as TB
+import Data.Time.Calendar (Day, addDays)
 import System.Console.CmdArgs.Explicit as C
 import Hledger.Read.CsvReader (CSV, printCSV)
 import Lucid as L hiding (value_)
-import Text.Tabular as T
+import Text.Tabular as Tab
 
 import Hledger
 import Hledger.Cli.Commands.Balance
 import Hledger.Cli.CliOptions
-import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutput)
+import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutputLazyText)
 
 -- | Description of a compound balance report command,
 -- from which we generate the command's cmdargs mode and IO action.
@@ -89,84 +96,83 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
 -- | Generate a runnable command from a compound balance command specification.
 compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
 compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=rspec, rawopts_=rawopts} j = do
-    let
+    writeOutputLazyText opts $ render cbr
-      ropts@ReportOpts{..} = rsOpts rspec
+  where
-      -- use the default balance type for this report, unless the user overrides
+    ropts@ReportOpts{..} = rsOpts rspec
-      mBalanceTypeOverride =
+    -- use the default balance type for this report, unless the user overrides
-        choiceopt parse rawopts where
+    mBalanceTypeOverride =
-          parse = \case
+      choiceopt parse rawopts where
-            "historical" -> Just HistoricalBalance
+        parse = \case
-            "cumulative" -> Just CumulativeChange
+          "historical" -> Just HistoricalBalance
-            "change"     -> Just PeriodChange
+          "cumulative" -> Just CumulativeChange
-            _            -> Nothing
+          "change"     -> Just PeriodChange
-      balancetype = fromMaybe cbctype mBalanceTypeOverride
+          _            -> Nothing
-      -- Set balance type in the report options.
+    balancetype = fromMaybe cbctype mBalanceTypeOverride
-      ropts' = ropts{balancetype_=balancetype}
+    -- Set balance type in the report options.
+    ropts' = ropts{balancetype_=balancetype}
 
-      title =
+    title =
-        cbctitle
+      T.pack cbctitle
-        ++ " "
+      <> " "
-        ++ titledatestr
+      <> titledatestr
-        ++ maybe "" (' ':) mtitleclarification
+      <> maybe "" (" "<>) mtitleclarification
-        ++ valuationdesc
+      <> valuationdesc
-        where
+      where
 
-          -- XXX #1078 the title of ending balance reports
+        -- XXX #1078 the title of ending balance reports
-          -- (HistoricalBalance) should mention the end date(s) shown as
+        -- (HistoricalBalance) should mention the end date(s) shown as
-          -- column heading(s) (not the date span of the transactions).
+        -- column heading(s) (not the date span of the transactions).
-          -- Also the dates should not be simplified (it should show
+        -- Also the dates should not be simplified (it should show
-          -- "2008/01/01-2008/12/31", not "2008").
+        -- "2008/01/01-2008/12/31", not "2008").
-          titledatestr = case balancetype of
+        titledatestr = case balancetype of
-              HistoricalBalance -> showEndDates enddates
+            HistoricalBalance -> showEndDates enddates
-              _                 -> showDateSpan requestedspan
+            _                 -> showDateSpan requestedspan
-            where
+          where
-              enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr  -- these spans will always have a definite end date
+            enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr  -- these spans will always have a definite end date
-              requestedspan = queryDateSpan date2_ (rsQuery rspec)
+            requestedspan = queryDateSpan date2_ (rsQuery rspec)
-                                  `spanDefaultsFrom` journalDateSpan date2_ j
+                                `spanDefaultsFrom` journalDateSpan date2_ j
 
-          -- when user overrides, add an indication to the report title
+        -- when user overrides, add an indication to the report title
-          mtitleclarification = flip fmap mBalanceTypeOverride $ \case
+        mtitleclarification = flip fmap mBalanceTypeOverride $ \case
-              PeriodChange | changingValuation -> "(Period-End Value Changes)"
+            PeriodChange | changingValuation -> "(Period-End Value Changes)"
-              PeriodChange                     -> "(Balance Changes)"
+            PeriodChange                     -> "(Balance Changes)"
-              CumulativeChange                 -> "(Cumulative Ending Balances)"
+            CumulativeChange                 -> "(Cumulative Ending Balances)"
-              HistoricalBalance                -> "(Historical Ending Balances)"
+            HistoricalBalance                -> "(Historical Ending Balances)"
 
-          valuationdesc = case value_ of
+        valuationdesc = case value_ of
-            Just (AtCost _mc)       -> ", valued at cost"
+          Just (AtCost _mc)       -> ", valued at cost"
-            Just (AtThen _mc)       -> error' unsupportedValueThenError  -- TODO
+          Just (AtThen _mc)       -> error' unsupportedValueThenError  -- TODO
-            Just (AtEnd _mc) | changingValuation -> ""
+          Just (AtEnd _mc) | changingValuation -> ""
-            Just (AtEnd _mc)        -> ", valued at period ends"
+          Just (AtEnd _mc)        -> ", valued at period ends"
-            Just (AtNow _mc)        -> ", current value"
+          Just (AtNow _mc)        -> ", current value"
-            Just (AtDate today _mc) -> ", valued at "++showDate today
+          Just (AtDate today _mc) -> ", valued at " <> showDate today
-            Nothing                 -> ""
+          Nothing                 -> ""
 
-          changingValuation = case (balancetype_, value_) of
+        changingValuation = case (balancetype_, value_) of
-              (PeriodChange, Just (AtEnd _)) -> interval_ /= NoInterval
+            (PeriodChange, Just (AtEnd _)) -> interval_ /= NoInterval
-              _                              -> False
+            _                              -> False
 
-      -- make a CompoundBalanceReport.
+    -- make a CompoundBalanceReport.
-      cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries
+    cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries
-      cbr  = cbr'{cbrTitle=title}
+    cbr  = cbr'{cbrTitle=title}
 
     -- render appropriately
-    writeOutput opts $ case outputFormatFromOpts opts of
+    render = case outputFormatFromOpts opts of
-        "txt"  -> compoundBalanceReportAsText ropts' cbr
+        "txt"  -> compoundBalanceReportAsText ropts'
-        "csv"  -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
+        "csv"  -> printCSV . compoundBalanceReportAsCsv ropts'
-        "html" -> (++"\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr
+        "html" -> L.renderText . compoundBalanceReportAsHtml ropts'
-        "json" -> (++"\n") $ TL.unpack $ toJsonText cbr
+        "json" -> toJsonText
         x      -> error' $ unsupportedOutputFormatError x
 
 -- | Summarise one or more (inclusive) end dates, in a way that's
 -- visually different from showDateSpan, suggesting discrete end dates
 -- rather than a continuous span.
-showEndDates :: [Day] -> String
+showEndDates :: [Day] -> T.Text
 showEndDates es = case es of
   -- cf showPeriod
-  (e:_:_) -> showdate e ++ ".." ++ showdate (last es)
+  (e:_:_) -> showDate e <> ".." <> showDate (last es)
-  [e]     -> showdate e
+  [e]     -> showDate e
   []      -> ""
-  where
-    showdate = show
 
 -- | Render a compound balance report as plain text suitable for console output.
 {- Eg:
@@ -188,15 +194,16 @@ Balance Sheet
  Total       ||           1        1        1
 
 -}
-compoundBalanceReportAsText :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> String
+compoundBalanceReportAsText :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> TL.Text
 compoundBalanceReportAsText ropts
   (CompoundPeriodicReport title _colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
-    title ++ "\n\n" ++
+    TB.toLazyText $
-    balanceReportTableAsText ropts bigtable'
+      TB.fromText title <> TB.fromText "\n\n" <>
+      balanceReportTableAsText ropts bigtable'
   where
     bigtable =
       case map (subreportAsTable ropts) subreports of
-        []   -> T.empty
+        []   -> Tab.empty
         r:rs -> foldl' concatTables r rs
     bigtable'
       | no_total_ ropts || length subreports == 1 =
@@ -217,11 +224,11 @@ compoundBalanceReportAsText ropts
         -- convert to table
         Table lefthdrs tophdrs cells = balanceReportAsTable ropts r
         -- tweak the layout
-        t = Table (T.Group SingleLine [Header title, lefthdrs]) tophdrs ([]:cells)
+        t = Table (Tab.Group SingleLine [Header title, lefthdrs]) tophdrs ([]:cells)
 
 -- | Add the second table below the first, discarding its column headings.
 concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') =
-    Table (T.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat')
+    Table (Tab.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat')
 
 -- | Render a compound balance report as CSV.
 -- Subreports' CSV is concatenated, with the headings rows replaced by a
@@ -229,14 +236,14 @@ concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') =
 -- optional overall totals row is added.
 compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV
 compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
-  addtotals $
+    addtotals $
-  padRow title :
+      padRow title
-  ("Account" :
+      : ( "Account"
-   map showDateSpanMonthAbbrev colspans
+        : map showDateSpanMonthAbbrev colspans
-   ++ (if row_total_ ropts then ["Total"] else [])
+        ++ (if row_total_ ropts then ["Total"] else [])
-   ++ (if average_ ropts then ["Average"] else [])
+        ++ (if average_ ropts then ["Average"] else [])
-   ) :
+        )
-  concatMap (subreportAsCsv ropts) subreports
+      : concatMap (subreportAsCsv ropts) subreports
   where
     -- | Add a subreport title row and drop the heading row.
     subreportAsCsv ropts (subreporttitle, multibalreport, _) =
@@ -256,7 +263,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor
       | no_total_ ropts || length subreports == 1 = id
       | otherwise = (++
           ["Net:" :
-           map (showMixedAmountOneLineWithoutPrice False) (
+           map (wbToText . showMixedAmountB oneLine) (
              coltotals
              ++ (if row_total_ ropts then [grandtotal] else [])
              ++ (if average_ ropts   then [grandavg]   else [])
@@ -268,7 +275,7 @@ compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName
 compoundBalanceReportAsHtml ropts cbr =
   let
     CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg) = cbr
-    colspanattr = colspan_ $ TS.pack $ show $
+    colspanattr = colspan_ $ T.pack $ show $
       1 + length colspans + (if row_total_ ropts then 1 else 0) + (if average_ ropts then 1 else 0)
     leftattr = style_ "text-align:left"
     blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw ("&nbsp;"::String)
@@ -282,12 +289,12 @@ compoundBalanceReportAsHtml ropts cbr =
           ++ (if average_ ropts then ["Average"] else [])
           ]
 
-    thRow :: [String] -> Html ()
+    thRow :: [T.Text] -> Html ()
     thRow = tr_ . mconcat . map (th_ . toHtml)
 
     -- Make rows for a subreport: its title row, not the headings row,
     -- the data rows, any totals row, and a blank row for whitespace.
-    subreportrows :: (String, MultiBalanceReport, Bool) -> [Html ()]
+    subreportrows :: (T.Text, MultiBalanceReport, Bool) -> [Html ()]
     subreportrows (subreporttitle, mbr, _increasestotal) =
       let
         (_,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr
@@ -300,16 +307,14 @@ compoundBalanceReportAsHtml ropts cbr =
     totalrows | no_total_ ropts || length subreports == 1 = []
               | otherwise =
                   let defstyle = style_ "text-align:right"
-                  in
+                      orEmpty b x = if b then x else mempty
-                    [tr_ $ mconcat $
+                  in [tr_ $ th_ [class_ "", style_ "text-align:left"] "Net:"
-                         th_ [class_ "", style_ "text-align:left"] "Net:"
+                         <> foldMap (th_ [class_ "amount coltotal", defstyle] . toHtml . wbUnpack . showMixedAmountB oneLine) coltotals
-                       : [th_ [class_ "amount coltotal", defstyle] (toHtml $ showMixedAmountOneLineWithoutPrice False a) | a <- coltotals]
+                         <> orEmpty (row_total_ ropts) (th_ [class_ "amount coltotal", defstyle] . toHtml . wbUnpack $ showMixedAmountB oneLine grandtotal)
-                      ++ (if row_total_ ropts then [th_ [class_ "amount coltotal", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice False grandtotal] else [])
+                         <> orEmpty (average_ ropts) (th_ [class_ "amount colaverage", defstyle] . toHtml . wbUnpack $ showMixedAmountB oneLine grandavg)
-                      ++ (if average_ ropts   then [th_ [class_ "amount colaverage", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice False grandavg] else [])
                     ]
-
   in do
-    style_ (TS.unlines [""
+    style_ (T.unlines [""
       ,"td { padding:0 0.5em; }"
       ,"td:nth-child(1) { white-space:nowrap; }"
       ,"tr:nth-child(even) td { background-color:#eee; }"

hledger/Hledger/Cli/Utils.hs

@@ -13,6 +13,7 @@ module Hledger.Cli.Utils
      unsupportedOutputFormatError,
      withJournalDo,
      writeOutput,
+     writeOutputLazyText,
      journalTransform,
      journalAddForecast,
      journalReload,
@@ -34,6 +35,8 @@ import Data.List
 import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
 import Data.Time (UTCTime, Day, addDays)
 import Safe (readMay)
 import System.Console.CmdArgs
@@ -159,6 +162,14 @@ writeOutput opts s = do
   f <- outputFileFromOpts opts
   (if f == "-" then putStr else writeFile f) s
 
+-- | Write some output to stdout or to a file selected by --output-file.
+-- If the file exists it will be overwritten. This function operates on Lazy
+-- Text values.
+writeOutputLazyText :: CliOpts -> TL.Text -> IO ()
+writeOutputLazyText opts s = do
+  f <- outputFileFromOpts opts
+  (if f == "-" then TL.putStr else TL.writeFile f) s
+
 -- -- | Get a journal from the given string and options, or throw an error.
 -- readJournal :: CliOpts -> String -> IO Journal
 -- readJournal opts s = readJournal def Nothing s >>= either error' return

hledger/test/account-aliases.test

@@ -135,7 +135,7 @@ $ hledger -f- balance --alias=cc=credit-card --alias=b=bank
                   75  bank
                   15  expenses
 --------------------
-                  90
+                  90  
 
 # 9. query will search both origin and substitution in alias
 <

hledger/test/amount-rendering.test

@@ -31,7 +31,7 @@ hledger -f - register
 >>>=0
 
 # 3. balance
-hledger -f - balance
+hledger -f - balance -N
 <<<
 2010/1/1
     a  EUR 1  ; a euro
@@ -40,10 +40,8 @@ hledger -f - balance
 >>>
                EUR 1  a
                USD 1  b
-              EUR -1   
+              EUR -1
               USD -1  c
---------------------
-                   0
 >>>=0
 
 # 4. a single-commodity zero amount's commodity/decimal places/price is preserved, when possible
@@ -63,7 +61,7 @@ hledger -f- print --explicit --empty
 # When preserving a zero amount's commodity, we should also preserve
 # the amount style, such as where to place the symbol.
 # https://github.com/simonmichael/hledger/issues/230
-hledger -f- balance --tree
+hledger -f- balance --tree -N
 <<<
 D 1000,00€
 
@@ -79,8 +77,6 @@ D 1000,00€
             4000,58€    1
            -1000,58€    D
            -3000,00€  e
---------------------
-                   0
 >>>= 0
 
 

hledger/test/balance/373-layout.test

@@ -16,22 +16,18 @@
   1                                         -1
 
 # 1. simple balance report in tree mode with zero/boring parents
-$ hledger -f - bal --tree
+$ hledger -f - bal --tree -N
                    0  1:2
                    1    3
                    0      4
                    1        5
---------------------
-                   0
 
 # 2. simple balance report in flat mode
-$ hledger -f - bal --flat
+$ hledger -f - bal --flat -N
                   -1  1:2
                    1  1:2:3
                   -1  1:2:3:4
                    1  1:2:3:4:5
---------------------
-                   0
 
 # 3. tabular balance report in flat mode
 $ hledger -f - bal -Y

hledger/test/balance/balance.test

@@ -12,7 +12,7 @@ hledger -f sample.journal balance --tree
                  $-1    salary
                   $1  liabilities:debts
 --------------------
-                   0
+                   0  
 >>>=0
 
 # 2.
@@ -23,11 +23,11 @@ hledger -f sample.journal balance --tree o
                  $-1    gifts
                  $-1    salary
 --------------------
-                 $-1
+                 $-1  
 >>>=0
 
 # 3. Period reporting works for a specific year
-hledger -f - balance -b 2016 -e 2017
+hledger -f - balance -b 2016 -e 2017 -N
 <<<
 2015/10/10 Client A | Invoice #1
     assets:receivables      $10,000.00
@@ -52,13 +52,11 @@ hledger -f - balance -b 2016 -e 2017
              $-40.00  assets:checking
               $50.00  expense:hosting
              $-10.00  revenue:clients:B
---------------------
-                   0
 >>>2
 >>>= 0
 
 # 4. Period reporting works for two years
-hledger -f - balance --tree -b 2015 -e 2017
+hledger -f - balance --tree -b 2015 -e 2017 -N
 <<<
 2015/10/10 Client A | Invoice #1
     assets:receivables      $10,000.00
@@ -85,13 +83,11 @@ hledger -f - balance --tree -b 2015 -e 2017
          $-10,010.00  revenue:clients
          $-10,000.00    A
              $-10.00    B
---------------------
-                   0
 >>>2
 >>>= 0
 
 # 5. Period reporting works for one month
-hledger -f - balance --tree -b 2015/11 -e 2015/12
+hledger -f - balance --tree -b 2015/11 -e 2015/12 -N
 <<<
 2015/10/10 Client A | Invoice #1
     assets:receivables      $10,000.00
@@ -116,8 +112,6 @@ hledger -f - balance --tree -b 2015/11 -e 2015/12
                    0  assets
           $10,000.00    checking
          $-10,000.00    receivables
---------------------
-                   0
 >>>2
 >>>= 0
 
@@ -145,7 +139,7 @@ hledger -f - balance -b 2016/10 -e 2016/11
     assets:receivables         -$10.00
 >>>
 --------------------
-                   0
+                   0  
 >>>2
 >>>= 0
 

hledger/test/balance/bcexample.test

@@ -3,19 +3,19 @@
 
 $ hledger -f bcexample.hledger bal -t -1 --color=always
 >
-             70.00 GLD        
+             70.00 GLD
-            17.00 ITOT        
+            17.00 ITOT
-489.957000000000 RGAGX        
+489.957000000000 RGAGX
-           5716.53 USD        
+           5716.53 USD
-          337.26 VACHR        
+          337.26 VACHR
-309.950000000000 VBMPX        
+309.950000000000 VBMPX
-             36.00 VEA        
+             36.00 VEA
             294.00 VHT  Assets
         -3077.70 USD  Equity
-     52000.00 IRAUSD          
+     52000.00 IRAUSD
        260911.70 USD  Expenses
-    -52000.00 IRAUSD        
+    -52000.00 IRAUSD
-      -365071.44 USD        
+      -365071.44 USD
        -337.26 VACHR  Income
         -2891.85 USD  Liabilities
 --------------------
@@ -25,5 +25,5 @@ $ hledger -f bcexample.hledger bal -t -1 --color=always
         -104412.76 USD
 309.950000000000 VBMPX
              36.00 VEA
-            294.00 VHT
+            294.00 VHT  
 >=0

hledger/test/balance/date2.test

@@ -1,4 +1,4 @@
-hledger -f - balance -p 'in 2009' --date2
+hledger -f - balance -p 'in 2009' --date2 -N
 <<<
 2009/1/1 x
   a  1
@@ -10,6 +10,4 @@ hledger -f - balance -p 'in 2009' --date2
 >>>
                    1  a
                   -1  b
---------------------
-                   0
 >>>=0

hledger/test/balance/flat.test

@@ -29,7 +29,7 @@ hledger -f - balance --flat
                    1  b
                    1  b:bb:bbb
 --------------------
-                   5
+                   5  
 >>>= 0
 
 # --flat --depth shows the same accounts, but clipped and aggregated at the depth limit
@@ -47,5 +47,5 @@ hledger -f - balance --flat --depth 2
                    1  b
                    1  b:bb
 --------------------
-                   5
+                   5  
 >>>= 0

hledger/test/balance/no-total-no-elide.test

@@ -13,7 +13,7 @@
 $ hledger -f - balance
 >
 --------------------
-                   0
+                   0  
 >=0
 
 <
@@ -48,7 +48,7 @@ $ hledger -f - balance --tree --no-total
 >=0
 
 <
-1/1
+2020/1/1
  (a)          1
  (a:aa)       1
  (a:aa)      -1

hledger/test/balance/percent.test

@@ -6,7 +6,7 @@ hledger -f sample.journal balance expenses -% --tree
               50.0 %    food
               50.0 %    supplies
 --------------------
-             100.0 %
+             100.0 %  
 >>>= 0
 
 # 2. Multi column percent

hledger/test/balance/precision.test

@@ -8,5 +8,5 @@ hledger -f- balance
                 1.00  a
                -1.00  b
 --------------------
-                   0
+                   0  
 >>>=0

hledger/test/i18n/unicode-balance.test

@@ -7,5 +7,5 @@ hledger -f - balance
               10 руб  τράπεζα
              -10 руб  नकद
 --------------------
-                   0
+                   0  
 >>>=0

hledger/test/i18n/wide-char-layout.test

@@ -54,7 +54,7 @@ hledger -f chinese.journal balance --tree
                    0      㐃
                  1 A        㐄
 --------------------
-                   0
+                   0  
 >>>2
 >>>=0
 

hledger/test/journal/amounts-and-commodities.test

@@ -43,7 +43,7 @@ $ hledger -f- balance
  10 "DE 0002 635307"  a
 -10 "DE 0002 635307"  b
 --------------------
-                   0
+                   0  
 
 # 5. autobalance with prices
 <
@@ -163,7 +163,7 @@ $ hledger -f- print
 	a 	 1 EUR	
 $ hledger -f- bal a
 --------------------
-                   0
+                   0  
 >=
 
 # 12. Example of surprising decimal mark parsing behaviour.

hledger/test/journal/auto-postings.test

@@ -47,7 +47,7 @@ $ hledger balance -f- --auto --tree
                $-100    remuneration
                 $-38  liabilities:tax
 --------------------
-                $-38
+                $-38  
 >=
 
 # Balance assertions see postings generated by transaction modifier rules.

hledger/test/journal/default-commodity.test

@@ -60,7 +60,7 @@ $ hledger -f- print
 # including limiting the display precision, like a commodity directive (#1187).
 <
 D 1,000.0 A
-1/1
+2020/1/1
   (a)  1000.123
 
 $ hledger -f- print

hledger/test/journal/numbers.test

@@ -81,7 +81,7 @@ D 1,000.00 EUR
         1,000.00 EUR  a
        -1,000.00 EUR  b
 --------------------
-                   0
+                   0  
 >>>2
 >>>=0
 
@@ -106,7 +106,7 @@ commodity 1,000.00 EUR
         1,000.00 EUR  a
        -1,000.00 EUR  b
 --------------------
-                   0
+                   0  
 >>>2
 >>>=0
 
@@ -122,7 +122,7 @@ commodity €1,000.00
            €1,000.00  a
           €-1,000.00  b
 --------------------
-                   0
+                   0  
 >>>2
 >>>=0
 
@@ -145,7 +145,7 @@ commodity 100. EUR
             1000 EUR  a
            -1000 EUR  b
 --------------------
-                   0
+                   0  
 >>>2
 >>>=0
 
@@ -209,7 +209,7 @@ hledger bal -f -
              0.1 EUR  a
             -0.1 EUR  b
 --------------------
-                   0
+                   0  
 >>>2
 >>>=0
 

hledger/test/journal/precision.test

@@ -61,7 +61,7 @@ hledger -f - balance --cost
             $3266.32  assets:investment:ACME
            $-3266.32  equity:opening balances
 --------------------
-                   0
+                   0  
 >>>=0
 
 # hledger 0.14pre: precision=2, presumably from price
@@ -91,7 +91,7 @@ D $1000.0
              $3266.3  assets:investment:ACME
             $-3266.3  equity:opening balances
 --------------------
-                   0
+                   0  
 >>>=0
 ### hledger 0.14pre: precision=2, presumably from price, ignores D
 ###            $3266.32  assets:investment:ACME

hledger/test/journal/scientific.test

@@ -68,7 +68,7 @@ hledger -f - bal --no-total
    (a)  1.00005e
    (a)  2.00003E
 >>>
-            2.00003E   
+            2.00003E
             1.00005e  a
 >>>=0
 

hledger/test/journal/transaction-prices.test

@@ -94,7 +94,7 @@ hledger -f - balance -B
                $-135  assets
                 $135  expenses:foreign currency
 --------------------
-                   0
+                   0  
 >>>=0
 
 # 8. transaction in two commodities should balance out properly
@@ -107,7 +107,7 @@ hledger -f - balance --cost
                  16$  a
                 -16$  b
 --------------------
-                   0
+                   0  
 >>>=0
 
 # 9. When commodity price is specified implicitly, transaction should
@@ -123,7 +123,7 @@ hledger -f - balance
                  16$  b
 --------------------
                  16$
-                -10£
+                -10£  
 >>>=0
 
 # 10. When commodity price is specified implicitly, transaction should
@@ -147,7 +147,7 @@ hledger -f - balance
 >>>
                   £2  a
 --------------------
-                  £2
+                  £2  
 >>>=0
 
 # 12. this should balance
@@ -188,7 +188,7 @@ hledger -f - balance --no-total
                  -1X  a
 >>>= 0
 
-# 16. 
+# 16.
 hledger -f - balance --no-total -B
 <<<
 1/1

hledger/test/journal/valuation.test

@@ -90,7 +90,7 @@ $ hledger -f- balance -V
             150.48 H  a
            -150.00 H  b
 --------------------
-              0.48 H
+              0.48 H  
 
 
 # 7. register -V affects posting amounts and total.

hledger/test/journal/virtual-postings.test

@@ -50,6 +50,6 @@ hledger -f- balance --tree
                   10  e
                  -10  f
 --------------------
-                   0
+                   0  
 >>>2
 >>>=0