lib,cli: Replace concat(Top|Bottom)Padded with textConcat(Top|Bottom)Padded.
This commit is contained in:
		
							parent
							
								
									56e87f934c
								
							
						
					
					
						commit
						bf22c3efdd
					
				| @ -90,7 +90,7 @@ import Hledger.Utils | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.Amount | ||||
| import Hledger.Data.AccountName | ||||
| import Hledger.Data.Dates (nulldate, spanContainsDate) | ||||
| import Hledger.Data.Dates (nulldate, showDate, spanContainsDate) | ||||
| 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 | ||||
| showPosting :: Posting -> String | ||||
| showPosting p@Posting{paccount=a,pamount=amt,ptype=t} = | ||||
|     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 = T.unpack . fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width | ||||
|       (bracket,width) = case t of | ||||
|                           BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2) | ||||
|                           VirtualPosting         -> (wrap "(" ")", acctnamewidth-2) | ||||
|                           _                      -> (id,acctnamewidth) | ||||
|       showamount = wbUnpack . showMixedAmountB noColour{displayMinWidth=Just 12} | ||||
|     T.unpack $ textConcatTopPadded [showDate (postingDate p) <> " ", showaccountname a <> " ", showamt, showComment $ pcomment p] | ||||
|   where | ||||
|     ledger3ishlayout = False | ||||
|     acctnamewidth = if ledger3ishlayout then 25 else 22 | ||||
|     showaccountname = fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width | ||||
|     (bracket,width) = case t of | ||||
|                         BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2) | ||||
|                         VirtualPosting         -> (wrap "(" ")", acctnamewidth-2) | ||||
|                         _                      -> (id,acctnamewidth) | ||||
|     showamt = wbToText $ showMixedAmountB noColour{displayMinWidth=Just 12} amt | ||||
| 
 | ||||
| 
 | ||||
| showComment :: Text -> Text | ||||
|  | ||||
| @ -13,22 +13,22 @@ module Hledger.Cli.Commands.Stats ( | ||||
| ) | ||||
| where | ||||
| 
 | ||||
| import Data.List | ||||
| import Data.Default (def) | ||||
| import Data.List (nub, sortOn) | ||||
| import Data.List.Extra (nubSort) | ||||
| import Data.Maybe | ||||
| import Data.Ord | ||||
| import Data.Maybe (fromMaybe) | ||||
| import Data.HashSet (size, fromList) | ||||
| -- import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| import Data.Time.Calendar | ||||
| import System.Console.CmdArgs.Explicit | ||||
| import Text.Printf | ||||
| import qualified Data.Text.Lazy.Builder as TB | ||||
| import Data.Time.Calendar (Day, addDays, diffDays) | ||||
| import System.Console.CmdArgs.Explicit hiding (Group) | ||||
| import Text.Printf (printf) | ||||
| import qualified Data.Map as Map | ||||
| 
 | ||||
| import Hledger | ||||
| import Hledger.Cli.CliOptions | ||||
| import Prelude hiding (putStr) | ||||
| import Hledger.Cli.Utils (writeOutput) | ||||
| import Hledger.Cli.Utils (writeOutputLazyText) | ||||
| import Text.Tabular.AsciiWide | ||||
| 
 | ||||
| 
 | ||||
| statsmode = hledgerCommandMode | ||||
| @ -49,64 +49,63 @@ stats opts@CliOpts{reportspec_=rspec} j = do | ||||
|       reportspan = ledgerDateSpan l `spanDefaultsFrom` queryDateSpan False q | ||||
|       intervalspans = splitSpan (interval_ $ rsOpts rspec) reportspan | ||||
|       showstats = showLedgerStats l d | ||||
|       s = intercalate "\n" $ map showstats intervalspans | ||||
|   writeOutput opts s | ||||
|       s = unlinesB $ map showstats intervalspans | ||||
|   writeOutputLazyText opts $ TB.toLazyText s | ||||
| 
 | ||||
| showLedgerStats :: Ledger -> Day -> DateSpan -> String | ||||
| showLedgerStats :: Ledger -> Day -> DateSpan -> TB.Builder | ||||
| showLedgerStats l today span = | ||||
|     unlines $ map (\(label,value) -> concatBottomPadded [printf fmt1 label, value]) stats | ||||
|     where | ||||
|       fmt1 = "%-" ++ show w1 ++ "s: " | ||||
|       -- fmt2 = "%-" ++ show w2 ++ "s" | ||||
|       w1 = maximum $ map (length . fst) stats | ||||
|       -- w2 = maximum $ map (length . show . snd) stats | ||||
|       stats = [ | ||||
|          ("Main file" :: String, path) -- ++ " (from " ++ source ++ ")") | ||||
|         ,("Included files", unlines $ drop 1 $ journalFilePaths j) | ||||
|         ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days) | ||||
|         ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed) | ||||
|         ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate) | ||||
|         ,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30) | ||||
|         ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7) | ||||
|         ,("Payees/descriptions", show $ size $ fromList $ map (tdescription) ts) | ||||
|         ,("Accounts", printf "%d (depth %d)" acctnum acctdepth) | ||||
|         ,("Commodities", printf "%s (%s)" (show $ length cs) (T.intercalate ", " cs)) | ||||
|         ,("Market prices", printf "%s (%s)" (show $ length mktprices) (T.intercalate ", " mktpricecommodities)) | ||||
|       -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s) | ||||
|       -- Unmarked transactions      : %(unmarked)s | ||||
|       -- Days since reconciliation   : %(reconcileelapsed)s | ||||
|       -- Days since last transaction : %(recentelapsed)s | ||||
|        ] | ||||
|            where | ||||
|              j = ljournal l | ||||
|              path = journalFilePath j | ||||
|              ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j | ||||
|              as = nub $ map paccount $ concatMap tpostings ts | ||||
|              cs = either error' Map.keys . commodityStylesFromAmounts . concatMap (amountsRaw . pamount) $ concatMap tpostings ts  -- PARTIAL: | ||||
|              lastdate | null ts = Nothing | ||||
|                       | otherwise = Just $ tdate $ last ts | ||||
|              lastelapsed = fmap (diffDays today) lastdate | ||||
|              showelapsed Nothing = "" | ||||
|              showelapsed (Just days) = printf " (%d %s)" days' direction | ||||
|                                        where days' = abs days | ||||
|                                              direction | days >= 0 = "days ago" :: String | ||||
|                                                        | otherwise = "days from now" | ||||
|              tnum = length ts | ||||
|              start (DateSpan (Just d) _) = show d | ||||
|              start _ = "" | ||||
|              end (DateSpan _ (Just d)) = show d | ||||
|              end _ = "" | ||||
|              days = fromMaybe 0 $ daysInSpan span | ||||
|              txnrate | days==0 = 0 | ||||
|                      | otherwise = fromIntegral tnum / fromIntegral days :: Double | ||||
|              tnum30 = length $ filter withinlast30 ts | ||||
|              withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t | ||||
|              txnrate30 = fromIntegral tnum30 / 30 :: Double | ||||
|              tnum7 = length $ filter withinlast7 ts | ||||
|              withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t | ||||
|              txnrate7 = fromIntegral tnum7 / 7 :: Double | ||||
|              acctnum = length as | ||||
|              acctdepth | null as = 0 | ||||
|                        | otherwise = maximum $ map accountNameLevel as | ||||
|              mktprices = jpricedirectives j | ||||
|              mktpricecommodities = nubSort $ map pdcommodity mktprices | ||||
|     unlinesB $ map (renderRowB def{tableBorders=False, borderSpaces=False} . showRow) stats | ||||
|   where | ||||
|     showRow (label, value) = Group NoLine $ map (Header . textCell TopLeft) | ||||
|       [fitText (Just w1) (Just w1) False True label `T.append` ": ", T.pack value] | ||||
|     w1 = maximum $ map (T.length . fst) stats | ||||
|     stats = [ | ||||
|        ("Main file", path) -- ++ " (from " ++ source ++ ")") | ||||
|       ,("Included files", unlines $ drop 1 $ journalFilePaths j) | ||||
|       ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days) | ||||
|       ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed) | ||||
|       ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate) | ||||
|       ,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30) | ||||
|       ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7) | ||||
|       ,("Payees/descriptions", show $ size $ fromList $ map (tdescription) ts) | ||||
|       ,("Accounts", printf "%d (depth %d)" acctnum acctdepth) | ||||
|       ,("Commodities", printf "%s (%s)" (show $ length cs) (T.intercalate ", " cs)) | ||||
|       ,("Market prices", printf "%s (%s)" (show $ length mktprices) (T.intercalate ", " mktpricecommodities)) | ||||
|     -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s) | ||||
|     -- Unmarked transactions      : %(unmarked)s | ||||
|     -- Days since reconciliation   : %(reconcileelapsed)s | ||||
|     -- Days since last transaction : %(recentelapsed)s | ||||
|      ] | ||||
|        where | ||||
|          j = ljournal l | ||||
|          path = journalFilePath j | ||||
|          ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j | ||||
|          as = nub $ map paccount $ concatMap tpostings ts | ||||
|          cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amountsRaw . pamount) $ concatMap tpostings ts  -- PARTIAL: | ||||
|          lastdate | null ts = Nothing | ||||
|                   | otherwise = Just $ tdate $ last ts | ||||
|          lastelapsed = fmap (diffDays today) lastdate | ||||
|          showelapsed Nothing = "" | ||||
|          showelapsed (Just days) = printf " (%d %s)" days' direction | ||||
|                                    where days' = abs days | ||||
|                                          direction | days >= 0 = "days ago" :: String | ||||
|                                                    | otherwise = "days from now" | ||||
|          tnum = length ts | ||||
|          start (DateSpan (Just d) _) = show d | ||||
|          start _ = "" | ||||
|          end (DateSpan _ (Just d)) = show d | ||||
|          end _ = "" | ||||
|          days = fromMaybe 0 $ daysInSpan span | ||||
|          txnrate | days==0 = 0 | ||||
|                  | otherwise = fromIntegral tnum / fromIntegral days :: Double | ||||
|          tnum30 = length $ filter withinlast30 ts | ||||
|          withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t | ||||
|          txnrate30 = fromIntegral tnum30 / 30 :: Double | ||||
|          tnum7 = length $ filter withinlast7 ts | ||||
|          withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t | ||||
|          txnrate7 = fromIntegral tnum7 / 7 :: Double | ||||
|          acctnum = length as | ||||
|          acctdepth | null as = 0 | ||||
|                    | otherwise = maximum $ map accountNameLevel as | ||||
|          mktprices = jpricedirectives j | ||||
|          mktpricecommodities = nubSort $ map pdcommodity mktprices | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user