lib: Use Text and Text builder only in postingAsLines.

hledger-lib/Hledger/Data/Amount.hs

@@ -125,6 +125,7 @@ module Hledger.Data.Amount (
   showMixedAmountElided,
   showMixedAmountWithZeroCommodity,
   showMixed,
+  showMixedLines,
   setMixedAmountPrecision,
   canonicaliseMixedAmount,
   -- * misc.

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

hledger-lib/Hledger/Data/Timeclock.hs

@@ -14,14 +14,15 @@ module Hledger.Data.Timeclock (
 )
 where
 
-import Data.Maybe
+import Data.Maybe (fromMaybe)
 -- 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

hledger-lib/Hledger/Data/Transaction.hs

@@ -44,8 +44,6 @@ module Hledger.Data.Transaction (
   -- * rendering
   showTransaction,
   showTransactionOneLineAmounts,
-  showTransactionUnelided,
-  showTransactionUnelidedOneLineAmounts,
   -- showPostingLine,
   showPostingLines,
   -- * GenericSourcePos
@@ -58,11 +56,14 @@ module Hledger.Data.Transaction (
 )
 where
 
+import Data.Default (def)
 import Data.List (intercalate, partition)
 import Data.List.Extra (nubSort)
 import Data.Maybe (fromMaybe, mapMaybe)
 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 Data.Time.Calendar (Day, fromGregorian)
 import qualified Data.Map as M
 
@@ -72,6 +73,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
@@ -149,30 +152,21 @@ are displayed as multiple similar postings, one per commodity.
 (Normally does not happen with this function).
 -}
 showTransaction :: Transaction -> Text
-showTransaction = showTransactionHelper False
+showTransaction = TL.toStrict . TB.toLazyText . showTransactionHelper False
-
--- | Deprecated alias for 'showTransaction'
-showTransactionUnelided :: Transaction -> Text
-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 -> Text
-showTransactionOneLineAmounts = showTransactionHelper True
+showTransactionOneLineAmounts = TL.toStrict . TB.toLazyText . showTransactionHelper True
-
--- | Deprecated alias for 'showTransactionOneLineAmounts'
-showTransactionUnelidedOneLineAmounts :: Transaction -> Text
-showTransactionUnelidedOneLineAmounts = showTransactionOneLineAmounts  -- TODO: drop it
 
 -- | Helper for showTransaction*.
-showTransactionHelper :: Bool -> Transaction -> Text
+showTransactionHelper :: Bool -> Transaction -> TB.Builder
 showTransactionHelper onelineamounts t =
-    T.unlines $
+      TB.fromText descriptionline <> newline
-      descriptionline
+    <> foldMap ((<> newline) . TB.fromText) newlinecomments
-      : newlinecomments
+    <> foldMap ((<> newline) . TB.fromText) (postingsAsLines onelineamounts $ tpostings t)
-      ++ (postingsAsLines onelineamounts (tpostings t))
+    <> newline
-      ++ [""]
   where
     descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment]
     date = showDate (tdate t) <> maybe "" (("="<>) . showDate) (tdate2 t)
@@ -184,6 +178,7 @@ showTransactionHelper onelineamounts t =
     (samelinecomment, newlinecomments) =
       case renderCommentLines (tcomment t) of []   -> ("",[])
                                               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.
@@ -238,15 +233,24 @@ postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamoun
 -- This is used to align the amounts of a transaction's postings.
 --
 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 (T.stripEnd . T.pack) . lines $
+    -- This needs to be converted to strict Text in order to strip trailing
-                       concatTopPadded [T.unpack statusandaccount, "  ", amt, assertion, T.unpack samelinecomment]
+    -- spaces. This adds a small amount of inefficiency, and the only difference
+    -- is whether there are trailing spaces in print (and related) reports. This
+    -- could be removed and we could just keep everything as a Text Builder, but
+    -- would require adding trailing spaces to 42 failing tests.
+    postingblocks = [map T.stripEnd . T.lines . TL.toStrict $
+                       render [ alignCell BottomLeft statusandaccount
+                              , alignCell BottomLeft "  "
+                              , Cell BottomLeft [amt]
+                              , Cell BottomLeft [assertion]
+                              , alignCell BottomLeft samelinecomment
+                              ]
                     | amt <- shownAmounts]
-    assertion = maybe "" ((' ':).showBalanceAssertion) $ pbalanceassertion p
+    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
@@ -259,8 +263,8 @@ postingAsLines elideamount onelineamounts pstoalignwith p = concat [
 
     -- currently prices are considered part of the amount string when right-aligning amounts
     shownAmounts
-      | elideamount || null (amounts $ pamount p) = [""]
+      | elideamount || null (amounts $ pamount p) = [mempty]
-      | otherwise = lines . wbUnpack . showMixed displayopts $ pamount p
+      | otherwise = showMixedLines displayopts $ pamount p
       where
         displayopts = noColour{displayOneLine=onelineamounts, displayMinWidth = Just amtwidth, displayNormalised=False}
         amtwidth = maximum $ 12 : map (wbWidth . showMixed displayopts{displayMinWidth=Nothing} . pamount) pstoalignwith  -- min. 12 for backwards compatibility
@@ -270,9 +274,13 @@ postingAsLines elideamount onelineamounts pstoalignwith p = concat [
                                               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 =
@@ -423,7 +431,9 @@ transactionBalanceError t errs =
 
 annotateErrorWithTransaction :: Transaction -> String -> String
 annotateErrorWithTransaction t s =
-  unlines [showGenericSourcePos $ tsourcepos t, s, T.unpack . T.stripEnd $ 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
@@ -769,7 +779,7 @@ tests_Transaction =
                 [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?=
           (T.unlines ["2007-01-28 coopportunity", "    expenses:food:groceries", ""])
         , test "show a transaction with a priced commodityless amount" $
-          (T.unpack $ showTransaction
+          (showTransaction
              (txnTieKnot $
               Transaction
                 0
@@ -785,7 +795,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

@@ -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.T.unpack.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

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)

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,
@@ -352,14 +350,3 @@ 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
-
--- | 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

@@ -45,6 +45,8 @@ module Hledger.Utils.Text
  -- cliptopleft,
  -- fitto,
   fitText,
+  linesPrepend,
+  linesPrepend2,
  -- -- * wide-character-aware layout
   WideBuilder(..),
   wbToText,
@@ -358,6 +360,17 @@ 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.

hledger/Hledger/Cli/Commands/Add.hs

@@ -469,7 +469,7 @@ ensureOneNewlineTerminated :: Text -> Text
 ensureOneNewlineTerminated = (<>"\n") . T.dropWhileEnd (=='\n')
 
 -- | Convert a string of journal data into a register report.
-registerFromString :: Text -> IO TL.Text
+registerFromString :: T.Text -> IO TL.Text
 registerFromString s = do
   j <- readJournal' s
   return . postingsReportAsText opts $ postingsReport rspec j

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

@@ -3,9 +3,9 @@ module Hledger.Cli.Commands.Check.Ordereddates (
 )
 where
 
+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 +22,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/Close.hs

@@ -10,10 +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
 import qualified Data.Text.IO as T
-import Data.Time.Calendar
+import Data.Time.Calendar (addDays)
 import System.Console.CmdArgs.Explicit as C
 
 import Hledger

hledger/Hledger/Cli/Commands/Diff.hs

@@ -12,15 +12,15 @@ 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)