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:
parent
36dd64cf02
commit
69c870c6f0
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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 " "
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user