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,64 +49,63 @@ 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", path) -- ++ " (from " ++ source ++ ")")
("Main file" :: String, 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) ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)
,("Transactions", printf "%d (%0.1f per day)" tnum txnrate) ,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30)
,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30) ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)
,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7) ,("Payees/descriptions", show $ size $ fromList $ map (tdescription) ts)
,("Payees/descriptions", show $ size $ fromList $ map (tdescription) ts) ,("Accounts", printf "%d (depth %d)" acctnum acctdepth)
,("Accounts", printf "%d (depth %d)" acctnum acctdepth) ,("Commodities", printf "%s (%s)" (show $ length cs) (T.intercalate ", " cs))
,("Commodities", printf "%s (%s)" (show $ length cs) (T.intercalate ", " cs)) ,("Market prices", printf "%s (%s)" (show $ length mktprices) (T.intercalate ", " mktpricecommodities))
,("Market prices", printf "%s (%s)" (show $ length mktprices) (T.intercalate ", " mktpricecommodities)) -- Transactions this month : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
-- Transactions this month : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s) -- Unmarked transactions : %(unmarked)s
-- Unmarked transactions : %(unmarked)s -- Days since reconciliation : %(reconcileelapsed)s
-- Days since reconciliation : %(reconcileelapsed)s -- Days since last transaction : %(recentelapsed)s
-- Days since last transaction : %(recentelapsed)s ]
] where
where j = ljournal l
j = ljournal l 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 showelapsed Nothing = ""
showelapsed Nothing = "" showelapsed (Just days) = printf " (%d %s)" days' direction
showelapsed (Just days) = printf " (%d %s)" days' direction where days' = abs days
where days' = abs days direction | days >= 0 = "days ago" :: String
direction | days >= 0 = "days ago" :: String | otherwise = "days from now"
| otherwise = "days from now" tnum = length ts
tnum = length ts start (DateSpan (Just d) _) = show d
start (DateSpan (Just d) _) = show d start _ = ""
start _ = "" end (DateSpan _ (Just d)) = show d
end (DateSpan _ (Just d)) = show d end _ = ""
end _ = "" days = fromMaybe 0 $ daysInSpan span
days = fromMaybe 0 $ daysInSpan span txnrate | days==0 = 0
txnrate | days==0 = 0 | otherwise = fromIntegral tnum / fromIntegral days :: Double
| otherwise = fromIntegral tnum / fromIntegral days :: Double tnum30 = length $ filter withinlast30 ts
tnum30 = length $ filter withinlast30 ts withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t
withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t txnrate30 = fromIntegral tnum30 / 30 :: Double
txnrate30 = fromIntegral tnum30 / 30 :: Double tnum7 = length $ filter withinlast7 ts
tnum7 = length $ filter withinlast7 ts withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t
withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t txnrate7 = fromIntegral tnum7 / 7 :: Double
txnrate7 = fromIntegral tnum7 / 7 :: Double acctnum = length as
acctnum = length as acctdepth | null as = 0
acctdepth | null as = 0 | otherwise = maximum $ map accountNameLevel as
| otherwise = maximum $ map accountNameLevel as mktprices = jpricedirectives j
mktprices = jpricedirectives j mktpricecommodities = nubSort $ map pdcommodity mktprices
mktpricecommodities = nubSort $ map pdcommodity mktprices