lib,cli: Replace concat(Top|Bottom)Padded with textConcat(Top|Bottom)Padded.

This commit is contained in:
Stephen Morgan 2021-04-22 15:20:56 +10:00 committed by Simon Michael
parent 56e87f934c
commit bf22c3efdd
2 changed files with 78 additions and 79 deletions

View File

@ -90,7 +90,7 @@ import Hledger.Utils
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.Amount import Hledger.Data.Amount
import Hledger.Data.AccountName import Hledger.Data.AccountName
import Hledger.Data.Dates (nulldate, spanContainsDate) import Hledger.Data.Dates (nulldate, showDate, spanContainsDate)
import Hledger.Data.Valuation import Hledger.Data.Valuation
@ -163,16 +163,16 @@ originalPosting p = fromMaybe p $ poriginal p
-- XXX once rendered user output, but just for debugging now; clean up -- XXX once rendered user output, but just for debugging now; clean up
showPosting :: Posting -> String showPosting :: Posting -> String
showPosting p@Posting{paccount=a,pamount=amt,ptype=t} = showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, T.unpack . showComment $ pcomment p]] T.unpack $ textConcatTopPadded [showDate (postingDate p) <> " ", showaccountname a <> " ", showamt, showComment $ pcomment p]
where where
ledger3ishlayout = False ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22 acctnamewidth = if ledger3ishlayout then 25 else 22
showaccountname = T.unpack . fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width showaccountname = fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width
(bracket,width) = case t of (bracket,width) = case t of
BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2) BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2)
VirtualPosting -> (wrap "(" ")", acctnamewidth-2) VirtualPosting -> (wrap "(" ")", acctnamewidth-2)
_ -> (id,acctnamewidth) _ -> (id,acctnamewidth)
showamount = wbUnpack . showMixedAmountB noColour{displayMinWidth=Just 12} showamt = wbToText $ showMixedAmountB noColour{displayMinWidth=Just 12} amt
showComment :: Text -> Text showComment :: Text -> Text

View File

@ -13,22 +13,22 @@ module Hledger.Cli.Commands.Stats (
) )
where where
import Data.List import Data.Default (def)
import Data.List (nub, sortOn)
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Maybe import Data.Maybe (fromMaybe)
import Data.Ord
import Data.HashSet (size, fromList) import Data.HashSet (size, fromList)
-- import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import qualified Data.Text.Lazy.Builder as TB
import System.Console.CmdArgs.Explicit import Data.Time.Calendar (Day, addDays, diffDays)
import Text.Printf import System.Console.CmdArgs.Explicit hiding (Group)
import Text.Printf (printf)
import qualified Data.Map as Map import qualified Data.Map as Map
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Prelude hiding (putStr) import Hledger.Cli.Utils (writeOutputLazyText)
import Hledger.Cli.Utils (writeOutput) import Text.Tabular.AsciiWide
statsmode = hledgerCommandMode statsmode = hledgerCommandMode
@ -49,19 +49,18 @@ stats opts@CliOpts{reportspec_=rspec} j = do
reportspan = ledgerDateSpan l `spanDefaultsFrom` queryDateSpan False q reportspan = ledgerDateSpan l `spanDefaultsFrom` queryDateSpan False q
intervalspans = splitSpan (interval_ $ rsOpts rspec) reportspan intervalspans = splitSpan (interval_ $ rsOpts rspec) reportspan
showstats = showLedgerStats l d showstats = showLedgerStats l d
s = intercalate "\n" $ map showstats intervalspans s = unlinesB $ map showstats intervalspans
writeOutput opts s writeOutputLazyText opts $ TB.toLazyText s
showLedgerStats :: Ledger -> Day -> DateSpan -> String showLedgerStats :: Ledger -> Day -> DateSpan -> TB.Builder
showLedgerStats l today span = showLedgerStats l today span =
unlines $ map (\(label,value) -> concatBottomPadded [printf fmt1 label, value]) stats unlinesB $ map (renderRowB def{tableBorders=False, borderSpaces=False} . showRow) stats
where where
fmt1 = "%-" ++ show w1 ++ "s: " showRow (label, value) = Group NoLine $ map (Header . textCell TopLeft)
-- fmt2 = "%-" ++ show w2 ++ "s" [fitText (Just w1) (Just w1) False True label `T.append` ": ", T.pack value]
w1 = maximum $ map (length . fst) stats w1 = maximum $ map (T.length . fst) stats
-- w2 = maximum $ map (length . show . snd) stats
stats = [ stats = [
("Main file" :: String, path) -- ++ " (from " ++ source ++ ")") ("Main file", path) -- ++ " (from " ++ source ++ ")")
,("Included files", unlines $ drop 1 $ journalFilePaths j) ,("Included files", unlines $ drop 1 $ journalFilePaths j)
,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days) ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days)
,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed) ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed)
@ -82,7 +81,7 @@ showLedgerStats l today span =
path = journalFilePath j path = journalFilePath j
ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j
as = nub $ map paccount $ concatMap tpostings ts as = nub $ map paccount $ concatMap tpostings ts
cs = either error' Map.keys . commodityStylesFromAmounts . concatMap (amountsRaw . pamount) $ concatMap tpostings ts -- PARTIAL: cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amountsRaw . pamount) $ concatMap tpostings ts -- PARTIAL:
lastdate | null ts = Nothing lastdate | null ts = Nothing
| otherwise = Just $ tdate $ last ts | otherwise = Just $ tdate $ last ts
lastelapsed = fmap (diffDays today) lastdate lastelapsed = fmap (diffDays today) lastdate