mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib: Use Text and Text builder only in postingAsLines.
This commit is contained in:
parent
13c111da73
commit
07a7c3d3a8
@ -125,6 +125,7 @@ module Hledger.Data.Amount (
|
||||
showMixedAmountElided,
|
||||
showMixedAmountWithZeroCommodity,
|
||||
showMixed,
|
||||
showMixedLines,
|
||||
setMixedAmountPrecision,
|
||||
canonicaliseMixedAmount,
|
||||
-- * misc.
|
||||
|
@ -87,20 +87,20 @@ module Hledger.Data.Journal (
|
||||
tests_Journal,
|
||||
)
|
||||
where
|
||||
import Control.Monad
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Extra
|
||||
|
||||
import Control.Monad.Except (ExceptT(..), runExceptT, throwError)
|
||||
import Control.Monad.Extra (whenM)
|
||||
import Control.Monad.Reader as R
|
||||
import Control.Monad.ST
|
||||
import Data.Array.ST
|
||||
import Control.Monad.ST (ST, runST)
|
||||
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.Tree
|
||||
import Data.Time.Calendar (Day, addDays, fromGregorian)
|
||||
import Data.Tree (Tree, flatten)
|
||||
import System.Time (ClockTime(TOD))
|
||||
import Text.Printf
|
||||
import Text.Printf (printf)
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Data.Types
|
||||
|
@ -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.Clock
|
||||
import Data.Time.Format
|
||||
import Data.Time.LocalTime
|
||||
import Text.Printf
|
||||
import Data.Time.Calendar (addDays)
|
||||
import Data.Time.Clock (addUTCTime, getCurrentTime)
|
||||
import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
|
||||
import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), getCurrentTimeZone,
|
||||
localTimeToUTC, midnight, utc, utcToLocalTime)
|
||||
import Text.Printf (printf)
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Data.Types
|
||||
|
@ -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
|
||||
|
||||
-- | Deprecated alias for 'showTransaction'
|
||||
showTransactionUnelided :: Transaction -> Text
|
||||
showTransactionUnelided = showTransaction -- TODO: drop it
|
||||
showTransaction = TL.toStrict . TB.toLazyText . showTransactionHelper False
|
||||
|
||||
-- | 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
|
||||
|
||||
-- | Deprecated alias for 'showTransactionOneLineAmounts'
|
||||
showTransactionUnelidedOneLineAmounts :: Transaction -> Text
|
||||
showTransactionUnelidedOneLineAmounts = showTransactionOneLineAmounts -- TODO: drop it
|
||||
showTransactionOneLineAmounts = TL.toStrict . TB.toLazyText . showTransactionHelper True
|
||||
|
||||
-- | Helper for showTransaction*.
|
||||
showTransactionHelper :: Bool -> Transaction -> Text
|
||||
showTransactionHelper :: Bool -> Transaction -> TB.Builder
|
||||
showTransactionHelper onelineamounts t =
|
||||
T.unlines $
|
||||
descriptionline
|
||||
: newlinecomments
|
||||
++ (postingsAsLines onelineamounts (tpostings t))
|
||||
++ [""]
|
||||
TB.fromText descriptionline <> newline
|
||||
<> foldMap ((<> newline) . TB.fromText) newlinecomments
|
||||
<> foldMap ((<> newline) . TB.fromText) (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 [
|
||||
postingblock
|
||||
++ newlinecomments
|
||||
| postingblock <- postingblocks]
|
||||
postingAsLines elideamount onelineamounts pstoalignwith p =
|
||||
concatMap (++ newlinecomments) postingblocks
|
||||
where
|
||||
postingblocks = [map (T.stripEnd . T.pack) . lines $
|
||||
concatTopPadded [T.unpack statusandaccount, " ", amt, assertion, T.unpack samelinecomment]
|
||||
-- This needs to be converted to strict Text in order to strip trailing
|
||||
-- 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) = [""]
|
||||
| otherwise = lines . wbUnpack . showMixed displayopts $ pamount p
|
||||
| elideamount || null (amounts $ pamount p) = [mempty]
|
||||
| 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" $
|
||||
|
@ -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
|
||||
|
@ -383,7 +383,7 @@ journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j
|
||||
printf "undeclared payee \"%s\"\nat: %s\n\n%s"
|
||||
(T.unpack p)
|
||||
(showGenericSourcePos $ tsourcepos t)
|
||||
(linesPrepend2 "> " " " $ chomp1 $ showTransaction t)
|
||||
(linesPrepend2 "> " " " . (<>"\n") . textChomp $ showTransaction t)
|
||||
where
|
||||
p = transactionPayee t
|
||||
ps = journalPayeesDeclared j
|
||||
@ -401,7 +401,7 @@ journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j
|
||||
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
|
||||
|
||||
@ -420,7 +420,7 @@ journalCheckCommoditiesDeclared j =
|
||||
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 =
|
||||
headMay $ filter (not . (`elem` cs)) $ catMaybes $
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
@ -23,15 +23,15 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
|
||||
FoldAcc{fa_error=Nothing} -> return ()
|
||||
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
|
||||
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
|
||||
txn2str = linesPrepend2 "> " " " $ showTransaction error
|
||||
Left $ printf "transaction date%s is out of order%s\nat %s:\n\n%s"
|
||||
(if date2_ ropts then "2" else "")
|
||||
uniquestr
|
||||
positionstr
|
||||
(txn1str ++ txn2str)
|
||||
txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous
|
||||
txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error
|
||||
Left $
|
||||
"Error: transaction date" <> datestr <> " is out of order"
|
||||
<> uniquestr <> "\nat " <> positionstr <> ":\n\n"
|
||||
<> txn1str <> txn2str
|
||||
|
||||
data FoldAcc a b = FoldAcc
|
||||
{ fa_error :: Maybe a
|
||||
|
@ -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
|
||||
|
@ -12,15 +12,15 @@ module Hledger.Cli.Commands.Diff (
|
||||
,diff
|
||||
) where
|
||||
|
||||
import Data.List
|
||||
import Data.Function
|
||||
import Data.Ord
|
||||
import Data.Maybe
|
||||
import Data.Time
|
||||
import Data.Either
|
||||
import Data.List ((\\), groupBy, nubBy, sortBy)
|
||||
import Data.Function (on)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Time (diffDays)
|
||||
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)
|
||||
|
Loading…
Reference in New Issue
Block a user