balance, lib: make StringFormat singular; cleanup

Pass around a StringFormat rather than [StringFormat].
Also more balance report item rendering refactoring.
This commit is contained in:
Simon Michael 2015-08-19 13:16:41 -07:00
parent 36dd64cf02
commit 69c870c6f0
3 changed files with 55 additions and 44 deletions

View File

@ -7,7 +7,8 @@
module Hledger.Data.StringFormat ( module Hledger.Data.StringFormat (
parseStringFormat parseStringFormat
, formatString , formatString
, StringFormat(..) , StringFormat
, StringFormatComponent(..)
, ReportItemField(..) , ReportItemField(..)
-- , stringformatp -- , stringformatp
, tests , tests
@ -24,8 +25,10 @@ import Text.Printf (printf)
-- | A format specification/template to use when rendering report line items as text. -- | A format specification/template to use when rendering report line items as text.
-- These are currently supported by the balance command. -- (Currently supported by the balance command in single-column mode).
data StringFormat = type StringFormat = [StringFormatComponent]
data StringFormatComponent =
FormatLiteral String FormatLiteral String
| FormatField Bool -- Left justified ? | FormatField Bool -- Left justified ?
(Maybe Int) -- Min width (Maybe Int) -- Min width
@ -33,6 +36,7 @@ data StringFormat =
ReportItemField -- Field name ReportItemField -- Field name
deriving (Show, Eq) deriving (Show, Eq)
-- | An id identifying which report item field to interpolate. These -- | An id identifying which report item field to interpolate. These
-- are drawn from several hledger report types, so are not all -- are drawn from several hledger report types, so are not all
-- applicable for a given report. -- applicable for a given report.
@ -55,7 +59,7 @@ formatString leftJustified min max s = printf fmt s
fmt = "%" ++ l ++ min' ++ max' ++ "s" fmt = "%" ++ l ++ min' ++ max' ++ "s"
-- | Parse a string format specification, or return a parse error. -- | Parse a string format specification, or return a parse error.
parseStringFormat :: String -> Either String [StringFormat] parseStringFormat :: String -> Either String StringFormat
parseStringFormat input = case (runParser (stringformatp <* eof) () "(unknown)") input of parseStringFormat input = case (runParser (stringformatp <* eof) () "(unknown)") input of
Left y -> Left $ show y Left y -> Left $ show y
Right x -> Right x Right x -> Right x
@ -71,7 +75,7 @@ field = do
<|> try (string "total" >> return TotalField) <|> try (string "total" >> return TotalField)
<|> try (many1 digit >>= (\s -> return $ FieldNo $ read s)) <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))
formatField :: Stream [Char] m Char => ParsecT [Char] st m StringFormat formatField :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent
formatField = do formatField = do
char '%' char '%'
leftJustified <- optionMaybe (char '-') leftJustified <- optionMaybe (char '-')
@ -86,7 +90,7 @@ formatField = do
Just text -> Just m where ((m,_):_) = readDec text Just text -> Just m where ((m,_):_) = readDec text
_ -> Nothing _ -> Nothing
formatLiteral :: Stream [Char] m Char => ParsecT [Char] st m StringFormat formatLiteral :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent
formatLiteral = do formatLiteral = do
s <- many1 c s <- many1 c
return $ FormatLiteral s return $ FormatLiteral s
@ -95,24 +99,24 @@ formatLiteral = do
c = (satisfy isPrintableButNotPercentage <?> "printable character") c = (satisfy isPrintableButNotPercentage <?> "printable character")
<|> try (string "%%" >> return '%') <|> try (string "%%" >> return '%')
formatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormat formatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent
formatp = formatp =
formatField formatField
<|> formatLiteral <|> formatLiteral
stringformatp :: Stream [Char] m Char => ParsecT [Char] st m [StringFormat] stringformatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormat
stringformatp = many formatp stringformatp = many formatp
---------------------------------------------------------------------- ----------------------------------------------------------------------
testFormat :: StringFormat -> String -> String -> Assertion testFormat :: StringFormatComponent -> String -> String -> Assertion
testFormat fs value expected = assertEqual name expected actual testFormat fs value expected = assertEqual name expected actual
where where
(name, actual) = case fs of (name, actual) = case fs of
FormatLiteral l -> ("literal", formatString False Nothing Nothing l) FormatLiteral l -> ("literal", formatString False Nothing Nothing l)
FormatField leftJustify min max _ -> ("field", formatString leftJustify min max value) FormatField leftJustify min max _ -> ("field", formatString leftJustify min max value)
testParser :: String -> [StringFormat] -> Assertion testParser :: String -> StringFormat -> Assertion
testParser s expected = case (parseStringFormat s) of testParser s expected = case (parseStringFormat s) of
Left error -> assertFailure $ show error Left error -> assertFailure $ show error
Right actual -> assertEqual ("Input: " ++ s) expected actual Right actual -> assertEqual ("Input: " ++ s) expected actual

View File

@ -408,40 +408,47 @@ This implementation turned out to be a bit convoluted but implements the followi
EUR -1 EUR -1
b USD -1 ; Account 'b' has two amounts. The account name is printed on the last line. b USD -1 ; Account 'b' has two amounts. The account name is printed on the last line.
-} -}
-- | Render one balance report line item as plain text suitable for console output. -- | Render one balance report line item as plain text suitable for console output (or
balanceReportItemAsText :: ReportOpts -> [StringFormat] -> BalanceReportItem -> [String] -- whatever string format is specified).
balanceReportItemAsText opts fmt ((_, accountName, depth), Mixed amounts) = balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String]
-- 'amounts' could contain several quantities of the same commodity with different price. balanceReportItemAsText opts fmt ((_, accountName, depth), amt) =
-- In order to combine them into single value (which is expected) we take the first price and let
-- use it for the whole mixed amount. This could be suboptimal. XXX
let Mixed normAmounts = normaliseMixedAmountSquashPricesForDisplay (Mixed amounts) in
case normAmounts of
[] -> []
[a] -> [formatBalanceReportItem fmt ((Just accountName'), depth, a)]
(as) -> multiline as
where
accountName' = maybeAccountNameDrop opts accountName accountName' = maybeAccountNameDrop opts accountName
multiline :: [Amount] -> [String] -- 'amounts' could contain several quantities of the same commodity with different price.
multiline [] = [] -- In order to combine them into single value (which is expected) we take the first price and
multiline [a] = [formatBalanceReportItem fmt ((Just accountName'), depth, a)] -- use it for the whole mixed amount. This could be suboptimal. XXX
multiline (a:as) = (formatBalanceReportItem fmt (Nothing, depth, a)) : multiline as amt' = normaliseMixedAmountSquashPricesForDisplay amt
in
formatBalanceReportItem fmt (accountName', depth, amt')
formatBalanceReportItem :: [StringFormat] -> (Maybe AccountName, Int, Amount) -> String -- | Render a balance report item using the given StringFormat, generating one or more lines of text.
formatBalanceReportItem [] (_, _, _) = "" formatBalanceReportItem :: StringFormat -> (AccountName, Int, MixedAmount) -> [String]
formatBalanceReportItem (fmt:fmts) (macctname, depth, amount) = formatBalanceReportItem [] _ = [""]
format fmt (macctname, depth, amount) ++ formatBalanceReportItem fmt (acctname, depth, Mixed amts) =
formatBalanceReportItem fmts (macctname, depth, amount) case amts of
where [] -> []
format :: StringFormat -> (Maybe AccountName, Int, Amount) -> String [a] -> [formatLine fmt (Just acctname, depth, a)]
format (FormatLiteral s) _ = s (a:as) -> [formatLine fmt (Just acctname, depth, a)] ++
format (FormatField ljust min max field) (macctname, depth, total) = case field of [formatLine fmt (Nothing, depth, a) | a <- as]
DepthSpacerField -> formatString ljust Nothing max $ replicate d ' '
where d = case min of -- | Render one line of a balance report item using the given StringFormat, maybe omitting the account name.
Just m -> depth * m formatLine :: StringFormat -> (Maybe AccountName, Int, Amount) -> String
Nothing -> depth formatLine [] _ = ""
AccountField -> formatString ljust min max $ fromMaybe "" macctname formatLine (fmt:fmts) (macctname, depth, amount) =
TotalField -> formatString ljust min max $ showAmountWithoutPrice total formatComponent fmt (macctname, depth, amount) ++
_ -> "" formatLine fmts (macctname, depth, amount)
-- | Render one StringFormat component of one line of a balance report item.
formatComponent :: StringFormatComponent -> (Maybe AccountName, Int, Amount) -> String
formatComponent (FormatLiteral s) _ = s
formatComponent (FormatField ljust min max field) (macctname, depth, total) = case field of
DepthSpacerField -> formatString ljust Nothing max $ replicate d ' '
where d = case min of
Just m -> depth * m
Nothing -> depth
AccountField -> formatString ljust min max $ fromMaybe "" macctname
TotalField -> formatString ljust min max $ showAmountWithoutPrice total
_ -> ""
-- multi-column balance reports -- multi-column balance reports

View File

@ -467,11 +467,11 @@ maybeAccountNameDrop opts a | tree_ opts = a
-- | Parse the format option if provided, possibly returning an error, -- | Parse the format option if provided, possibly returning an error,
-- otherwise get the default value. -- otherwise get the default value.
lineFormatFromOpts :: ReportOpts -> Either String [StringFormat] lineFormatFromOpts :: ReportOpts -> Either String StringFormat
lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_ lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_
-- | 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 = [ defaultBalanceLineFormat = [
FormatField False (Just 20) Nothing TotalField FormatField False (Just 20) Nothing TotalField
, FormatLiteral " " , FormatLiteral " "