lib: Remove unused optional width argument for StringFormat.

This commit is contained in:
Stephen Morgan 2020-11-10 16:30:11 +11:00
parent 462a13cad7
commit f998a791cf
7 changed files with 81 additions and 95 deletions

View File

@ -13,7 +13,6 @@ module Hledger.Data.StringFormat (
, StringFormat(..) , StringFormat(..)
, StringFormatComponent(..) , StringFormatComponent(..)
, ReportItemField(..) , ReportItemField(..)
, overlineWidth
, defaultBalanceLineFormat , defaultBalanceLineFormat
, tests_StringFormat , tests_StringFormat
) where ) where
@ -35,12 +34,9 @@ import Hledger.Utils.Test
-- | A format specification/template to use when rendering a report line item as text. -- | A format specification/template to use when rendering a report line item as text.
-- --
-- A format is an optional width, along with a sequence of components; -- A format is a sequence of components; each is either a literal
-- each is either a literal string, or a hledger report item field with -- string, or a hledger report item field with specified width and
-- specified width and justification whose value will be interpolated -- justification whose value will be interpolated at render time.
-- at render time. The optional width determines the length of the
-- overline to draw above the totals row; if it is Nothing, then the
-- maximum width of all lines is used.
-- --
-- A component's value may be a multi-line string (or a -- A component's value may be a multi-line string (or a
-- multi-commodity amount), in which case the final string will be -- multi-commodity amount), in which case the final string will be
@ -51,9 +47,9 @@ import Hledger.Utils.Test
-- mode, which provides a limited StringFormat renderer. -- mode, which provides a limited StringFormat renderer.
-- --
data StringFormat = data StringFormat =
OneLine (Maybe Int) [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated OneLine [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated
| TopAligned (Maybe Int) [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height) | TopAligned [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height)
| BottomAligned (Maybe Int) [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded) | BottomAligned [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded)
deriving (Show, Eq) deriving (Show, Eq)
data StringFormatComponent = data StringFormatComponent =
@ -85,14 +81,9 @@ data ReportItemField =
instance Default StringFormat where def = defaultBalanceLineFormat instance Default StringFormat where def = defaultBalanceLineFormat
overlineWidth :: StringFormat -> Maybe Int
overlineWidth (OneLine w _) = w
overlineWidth (TopAligned w _) = w
overlineWidth (BottomAligned w _) = w
-- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)" -- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)"
defaultBalanceLineFormat :: StringFormat defaultBalanceLineFormat :: StringFormat
defaultBalanceLineFormat = BottomAligned (Just 20) [ defaultBalanceLineFormat = BottomAligned [
FormatField False (Just 20) Nothing TotalField FormatField False (Just 20) Nothing TotalField
, FormatLiteral " " , FormatLiteral " "
, FormatField True (Just 2) Nothing DepthSpacerField , FormatField True (Just 2) Nothing DepthSpacerField
@ -118,10 +109,10 @@ stringformatp = do
alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String)) alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String))
let constructor = let constructor =
case alignspec of case alignspec of
Just '^' -> TopAligned Nothing Just '^' -> TopAligned
Just '_' -> BottomAligned Nothing Just '_' -> BottomAligned
Just ',' -> OneLine Nothing Just ',' -> OneLine
_ -> defaultStringFormatStyle Nothing _ -> defaultStringFormatStyle
constructor <$> many componentp constructor <$> many componentp
componentp :: SimpleTextParser StringFormatComponent componentp :: SimpleTextParser StringFormatComponent
@ -182,23 +173,23 @@ tests_StringFormat = tests "StringFormat" [
,let s `gives` expected = test s $ parseStringFormat (T.pack s) @?= Right expected ,let s `gives` expected = test s $ parseStringFormat (T.pack s) @?= Right expected
in tests "parseStringFormat" [ in tests "parseStringFormat" [
"" `gives` (defaultStringFormatStyle Nothing []) "" `gives` (defaultStringFormatStyle [])
, "D" `gives` (defaultStringFormatStyle Nothing [FormatLiteral "D"]) , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"])
, "%(date)" `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing DescriptionField]) , "%(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField])
, "%(total)" `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing TotalField]) , "%(total)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField])
-- TODO -- TODO
-- , "^%(total)" `gives` (TopAligned [FormatField False Nothing Nothing TotalField]) -- , "^%(total)" `gives` (TopAligned [FormatField False Nothing Nothing TotalField])
-- , "_%(total)" `gives` (BottomAligned [FormatField False Nothing Nothing TotalField]) -- , "_%(total)" `gives` (BottomAligned [FormatField False Nothing Nothing TotalField])
-- , ",%(total)" `gives` (OneLine [FormatField False Nothing Nothing TotalField]) -- , ",%(total)" `gives` (OneLine [FormatField False Nothing Nothing TotalField])
, "Hello %(date)!" `gives` (defaultStringFormatStyle Nothing [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]) , "Hello %(date)!" `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"])
, "%-(date)" `gives` (defaultStringFormatStyle Nothing [FormatField True Nothing Nothing DescriptionField]) , "%-(date)" `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField])
, "%20(date)" `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing DescriptionField]) , "%20(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField])
, "%.10(date)" `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing (Just 10) DescriptionField]) , "%.10(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField])
, "%20.10(date)" `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) (Just 10) DescriptionField]) , "%20.10(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField])
, "%20(account) %.10(total)" `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing AccountField , "%20(account) %.10(total)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField
,FormatLiteral " " ,FormatLiteral " "
,FormatField False Nothing (Just 10) TotalField ,FormatField False Nothing (Just 10) TotalField
]) ])
, test "newline not parsed" $ assertLeft $ parseStringFormat "\n" , test "newline not parsed" $ assertLeft $ parseStringFormat "\n"
] ]
] ]

View File

@ -100,8 +100,8 @@ textChomp = T.dropWhileEnd (`elem` ['\r', '\n'])
-- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it. -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.
-- Works on multi-line strings too (but will rewrite non-unix line endings). -- Works on multi-line strings too (but will rewrite non-unix line endings).
formatText :: Bool -> Maybe Int -> Maybe Int -> Text -> Text formatText :: Bool -> Maybe Int -> Maybe Int -> Text -> Text
formatText leftJustified minwidth maxwidth = formatText leftJustified minwidth maxwidth t =
T.intercalate "\n" . map (pad . clip) . T.lines T.intercalate "\n" . map (pad . clip) $ if T.null t then [""] else T.lines t
where where
pad = maybe id justify minwidth pad = maybe id justify minwidth
clip = maybe id T.take maxwidth clip = maybe id T.take maxwidth

View File

@ -254,6 +254,7 @@ module Hledger.Cli.Commands.Balance (
,tests_Balance ,tests_Balance
) where ) where
import Control.Arrow (first)
import Data.Default (def) import Data.Default (def)
import Data.List (intersperse, transpose) import Data.List (intersperse, transpose)
import Data.Maybe (fromMaybe, maybeToList) import Data.Maybe (fromMaybe, maybeToList)
@ -366,18 +367,22 @@ balanceReportAsCsv opts (items, total) =
-- | Render a single-column balance report as plain text. -- | Render a single-column balance report as plain text.
balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
balanceReportAsText opts ((items, total)) = balanceReportAsText opts ((items, total)) =
unlinesB lines <> unlinesB (if no_total_ opts then [] else [overline, totallines]) unlinesB lines
<> unlinesB (if no_total_ opts then [] else [overline, totalLines])
where where
unlinesB [] = mempty unlinesB [] = mempty
unlinesB xs = mconcat (intersperse (TB.singleton '\n') xs) <> TB.singleton '\n' unlinesB xs = mconcat (intersperse (TB.singleton '\n') xs) <> TB.singleton '\n'
lines = map (balanceReportItemAsText opts) items (lines, sizes) = unzip $ map (balanceReportItemAsText opts) items
-- abuse renderBalanceReportItem to render the total with similar format -- abuse renderBalanceReportItem to render the total with similar format
totallines = renderBalanceReportItem opts ("", 0, total) (totalLines, _) = renderBalanceReportItem opts ("",0,total)
-- with a custom format, extend the line to the full report width; -- with a custom format, extend the line to the full report width;
-- otherwise show the usual 20-char line for compatibility -- otherwise show the usual 20-char line for compatibility
overlinewidth = fromMaybe 22 . overlineWidth $ format_ opts overlinewidth = case format_ opts of
--overlinewidth = fromMaybe (maximum' . map length $ concat lines) . overlineWidth $ format_ opts OneLine ((FormatField _ _ _ TotalField):_) -> 20
TopAligned ((FormatField _ _ _ TotalField):_) -> 20
BottomAligned ((FormatField _ _ _ TotalField):_) -> 20
_ -> sum (map maximum' $ transpose sizes)
overline = TB.fromText $ T.replicate overlinewidth "-" overline = TB.fromText $ T.replicate overlinewidth "-"
{- {-
@ -395,7 +400,7 @@ This implementation turned out to be a bit convoluted but implements the followi
-- whatever string format is specified). Note, prices will not be rendered, and -- whatever string format is specified). Note, prices will not be rendered, and
-- differently-priced quantities of the same commodity will appear merged. -- differently-priced quantities of the same commodity will appear merged.
-- The output will be one or more lines depending on the format and number of commodities. -- The output will be one or more lines depending on the format and number of commodities.
balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> TB.Builder balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (TB.Builder, [Int])
balanceReportItemAsText opts (_, accountName, depth, amt) = balanceReportItemAsText opts (_, accountName, depth, amt) =
renderBalanceReportItem opts ( renderBalanceReportItem opts (
accountName, accountName,
@ -404,46 +409,36 @@ balanceReportItemAsText opts (_, accountName, depth, amt) =
) )
-- | Render a balance report item using the given StringFormat, generating one or more lines of text. -- | Render a balance report item using the given StringFormat, generating one or more lines of text.
renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> TB.Builder renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int])
renderBalanceReportItem opts (acctname, depth, total) = renderBalanceReportItem opts (acctname, depth, total) =
case format_ opts of case format_ opts of
OneLine _ comps -> foldMap (TB.fromText . T.intercalate ", ") $ render1 comps OneLine comps -> renderRow' $ render True True comps
TopAligned _ comps -> renderRow' TopLeft $ render comps TopAligned comps -> renderRow' $ render True False comps
BottomAligned _ comps -> renderRow' BottomLeft $ render comps BottomAligned comps -> renderRow' $ render False False comps
where where
renderRow' align = renderRowB def{tableBorders=False, borderSpaces=False} renderRow' is = ( renderRowB def{tableBorders=False, borderSpaces=False}
. Tab.Group NoLine . map (Header . cell) . Tab.Group NoLine $ map Header is
where cell = Cell align . map (\x -> (x, textWidth x)) , map cellWidth is )
render topaligned oneline = map (maybeConcat . renderComponent topaligned opts (acctname, depth, total))
where maybeConcat (Cell a xs) = if oneline then Cell a [(T.intercalate ", " strs, width)]
else Cell a xs
where
(strs, ws) = unzip xs
width = sumStrict (map (+2) ws) -2
render1 = map (T.lines . renderComponent1 opts (acctname, depth, total))
render = map (T.lines . renderComponent opts (acctname, depth, total))
-- | Render one StringFormat component for a balance report item. -- | Render one StringFormat component for a balance report item.
renderComponent :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> T.Text renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell
renderComponent _ _ (FormatLiteral s) = s renderComponent _ _ _ (FormatLiteral s) = Cell TopLeft . map (\x -> (x, textWidth x)) $ T.lines s
renderComponent opts (acctname, depth, total) (FormatField ljust min max field) = case field of renderComponent topaligned opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of
DepthSpacerField -> formatText ljust Nothing max $ T.replicate d " " DepthSpacerField -> Cell align [(T.replicate d " ", d)]
where d = case min of where d = maybe id min mmax $ depth * fromMaybe 1 mmin
Just m -> depth * m AccountField -> Cell align [(t, textWidth t)] where t = formatText ljust mmin mmax acctname
Nothing -> depth TotalField -> Cell align . pure . first T.pack $ showMixed showAmountWithoutPrice mmin mmax (color_ opts) total
AccountField -> formatText ljust min max acctname _ -> Cell align [("", 0)]
TotalField -> T.pack . fst $ showMixed showAmountWithoutPrice min max (color_ opts) total where align = if topaligned then (if ljust then TopLeft else TopRight)
_ -> "" else (if ljust then BottomLeft else BottomRight)
-- | Render one StringFormat component for a balance report item.
-- This variant is for use with OneLine string formats; it squashes
-- any multi-line rendered values onto one line, comma-and-space separated,
-- while still complying with the width spec.
renderComponent1 :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> T.Text
renderComponent1 _ _ (FormatLiteral s) = s
renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field) = case field of
AccountField -> formatText ljust min max . T.intercalate ", " . T.lines $ indented acctname
where
-- better to indent the account name here rather than use a DepthField component
-- so that it complies with width spec. Uses a fixed indent step size.
indented = ((T.replicate (depth*2) " ")<>)
TotalField -> T.pack . fst $ showMixedOneLine showAmountWithoutPrice min max (color_ opts) total
_ -> ""
-- rendering multi-column balance reports -- rendering multi-column balance reports