diff --git a/hledger-lib/Hledger/Data/OutputFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs similarity index 64% rename from hledger-lib/Hledger/Data/OutputFormat.hs rename to hledger-lib/Hledger/Data/StringFormat.hs index 499d60e35..7e4ac2459 100644 --- a/hledger-lib/Hledger/Data/OutputFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -1,10 +1,15 @@ +-- | Parse format strings provided by --format, with awareness of +-- hledger's report item fields. Also provides a string formatting +-- helper. + {-# LANGUAGE FlexibleContexts #-} -module Hledger.Data.OutputFormat ( + +module Hledger.Data.StringFormat ( parseStringFormat - , formatsp - , formatValue - , OutputFormat(..) - , HledgerFormatField(..) + , formatString + , StringFormat(..) + , ReportItemField(..) + -- , stringformatp , tests ) where @@ -15,29 +20,49 @@ import Data.Char (isPrint) import Data.Maybe import Test.HUnit import Text.Parsec -import Text.Printf - -import Hledger.Data.Types +import Text.Printf (printf) -formatValue :: Bool -> Maybe Int -> Maybe Int -> String -> String -formatValue leftJustified min max value = printf formatS value +-- | A format specification/template to use when rendering report line items as text. +-- These are currently supported by the balance command. +data StringFormat = + FormatLiteral String + | FormatField Bool -- Left justified ? + (Maybe Int) -- Min width + (Maybe Int) -- Max width + ReportItemField -- Field name + deriving (Show, Eq) + +-- | An id identifying which report item field to interpolate. These +-- are drawn from several hledger report types, so are not all +-- applicable for a given report. +data ReportItemField = + AccountField + | DefaultDateField + | DescriptionField + | TotalField + | DepthSpacerField + | FieldNo Int + deriving (Show, Eq) + +-- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it. +formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String +formatString leftJustified min max s = printf fmt s where l = if leftJustified then "-" else "" min' = maybe "" show min max' = maybe "" (\i -> "." ++ (show i)) max - formatS = "%" ++ l ++ min' ++ max' ++ "s" + fmt = "%" ++ l ++ min' ++ max' ++ "s" -parseStringFormat :: String -> Either String [OutputFormat] -parseStringFormat input = case (runParser (formatsp <* eof) () "(unknown)") input of +-- | Parse a string format specification, or return a parse error. +parseStringFormat :: String -> Either String [StringFormat] +parseStringFormat input = case (runParser (stringformatp <* eof) () "(unknown)") input of Left y -> Left $ show y Right x -> Right x -{- -Parsers --} +---------------------------------------------------------------------- -field :: Stream [Char] m Char => ParsecT [Char] st m HledgerFormatField +field :: Stream [Char] m Char => ParsecT [Char] st m ReportItemField field = do try (string "account" >> return AccountField) <|> try (string "depth_spacer" >> return DepthSpacerField) @@ -46,7 +71,7 @@ field = do <|> try (string "total" >> return TotalField) <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s)) -formatField :: Stream [Char] m Char => ParsecT [Char] st m OutputFormat +formatField :: Stream [Char] m Char => ParsecT [Char] st m StringFormat formatField = do char '%' leftJustified <- optionMaybe (char '-') @@ -61,7 +86,7 @@ formatField = do Just text -> Just m where ((m,_):_) = readDec text _ -> Nothing -formatLiteral :: Stream [Char] m Char => ParsecT [Char] st m OutputFormat +formatLiteral :: Stream [Char] m Char => ParsecT [Char] st m StringFormat formatLiteral = do s <- many1 c return $ FormatLiteral s @@ -70,22 +95,24 @@ formatLiteral = do c = (satisfy isPrintableButNotPercentage "printable character") <|> try (string "%%" >> return '%') -formatp :: Stream [Char] m Char => ParsecT [Char] st m OutputFormat +formatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormat formatp = formatField <|> formatLiteral -formatsp :: Stream [Char] m Char => ParsecT [Char] st m [OutputFormat] -formatsp = many formatp +stringformatp :: Stream [Char] m Char => ParsecT [Char] st m [StringFormat] +stringformatp = many formatp -testFormat :: OutputFormat -> String -> String -> Assertion +---------------------------------------------------------------------- + +testFormat :: StringFormat -> String -> String -> Assertion testFormat fs value expected = assertEqual name expected actual where (name, actual) = case fs of - FormatLiteral l -> ("literal", formatValue False Nothing Nothing l) - FormatField leftJustify min max _ -> ("field", formatValue leftJustify min max value) + FormatLiteral l -> ("literal", formatString False Nothing Nothing l) + FormatField leftJustify min max _ -> ("field", formatString leftJustify min max value) -testParser :: String -> [OutputFormat] -> Assertion +testParser :: String -> [StringFormat] -> Assertion testParser s expected = case (parseStringFormat s) of Left error -> assertFailure $ show error Right actual -> assertEqual ("Input: " ++ s) expected actual diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index c66a5bb46..2791da202 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -265,10 +265,11 @@ instance NFData Journal type JournalUpdate = ExceptT String IO (Journal -> Journal) -- | The id of a data format understood by hledger, eg @journal@ or @csv@. +-- The --output-format option selects one of these for output. type StorageFormat = String --- | A hledger journal reader is a triple of format name, format-detecting --- predicate, and a parser to Journal. +-- | A hledger journal reader is a triple of storage format name, a +-- detector of that format, and a parser from that format to Journal. data Reader = Reader { -- name of the format this reader handles rFormat :: StorageFormat @@ -280,26 +281,6 @@ data Reader = Reader { instance Show Reader where show r = rFormat r ++ " reader" --- format strings - -data HledgerFormatField = - AccountField - | DefaultDateField - | DescriptionField - | TotalField - | DepthSpacerField - | FieldNo Int - deriving (Show, Eq) - -data OutputFormat = - FormatLiteral String - | FormatField Bool -- Left justified ? - (Maybe Int) -- Min width - (Maybe Int) -- Max width - HledgerFormatField -- Field - deriving (Show, Eq) - - -- | An account, with name, balances and links to parent/subaccounts -- which let you walk up or down the account tree. data Account = Account { @@ -313,8 +294,6 @@ data Account = Account { aboring :: Bool -- ^ used in the accounts report to label elidable parents } - - -- | A Ledger has the journal it derives from, and the accounts -- derived from that. Accounts are accessible both list-wise and -- tree-wise, since each one knows its parent and subs; the first @@ -323,3 +302,4 @@ data Ledger = Ledger { ljournal :: Journal, laccounts :: [Account] } + diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index d4704d228..f4611a7b4 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -88,7 +88,7 @@ library Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger - Hledger.Data.OutputFormat + Hledger.Data.StringFormat Hledger.Data.Posting Hledger.Data.RawOptions Hledger.Data.TimeLog diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 77c26515e..ac6bb6403 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -101,7 +101,7 @@ library: - Hledger.Data.Dates - Hledger.Data.Journal - Hledger.Data.Ledger - - Hledger.Data.OutputFormat + - Hledger.Data.StringFormat - Hledger.Data.Posting - Hledger.Data.RawOptions - Hledger.Data.TimeLog diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index f7a0c822d..23e9e6778 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -253,7 +253,7 @@ import Text.Tabular as T import Text.Tabular.AsciiArt import Hledger -import Hledger.Data.OutputFormat +import Hledger.Data.StringFormat import Hledger.Cli.Options import Hledger.Cli.Utils @@ -374,8 +374,8 @@ balanceReportAsText :: ReportOpts -> BalanceReport -> String balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t where lines = case lineFormatFromOpts opts of - Right f -> map (balanceReportItemAsText opts f) items - Left err -> [[err]] + Right fmt -> map (balanceReportItemAsText opts fmt) items + Left err -> [[err]] t = if no_total_ opts then [] else ["--------------------" @@ -409,39 +409,39 @@ This implementation turned out to be a bit convoluted but implements the followi 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. -balanceReportItemAsText :: ReportOpts -> [OutputFormat] -> BalanceReportItem -> [String] -balanceReportItemAsText opts format ((_, accountName, depth), Mixed amounts) = +balanceReportItemAsText :: ReportOpts -> [StringFormat] -> BalanceReportItem -> [String] +balanceReportItemAsText opts fmt ((_, accountName, depth), Mixed amounts) = -- 'amounts' could contain several quantities of the same commodity with different price. -- In order to combine them into single value (which is expected) we take the first price and -- use it for the whole mixed amount. This could be suboptimal. XXX let Mixed normAmounts = normaliseMixedAmountSquashPricesForDisplay (Mixed amounts) in case normAmounts of [] -> [] - [a] -> [formatBalanceReportItem opts (Just accountName) depth a format] + [a] -> [formatBalanceReportItem fmt ((Just accountName'), depth, a)] (as) -> multiline as where + accountName' = maybeAccountNameDrop opts accountName multiline :: [Amount] -> [String] multiline [] = [] - multiline [a] = [formatBalanceReportItem opts (Just accountName) depth a format] - multiline (a:as) = (formatBalanceReportItem opts Nothing depth a format) : multiline as + multiline [a] = [formatBalanceReportItem fmt ((Just accountName'), depth, a)] + multiline (a:as) = (formatBalanceReportItem fmt (Nothing, depth, a)) : multiline as -formatBalanceReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [OutputFormat] -> String -formatBalanceReportItem _ _ _ _ [] = "" -formatBalanceReportItem opts accountName depth amount (fmt:fmts) = - s ++ (formatBalanceReportItem opts accountName depth amount fmts) +formatBalanceReportItem :: [StringFormat] -> (Maybe AccountName, Int, Amount) -> String +formatBalanceReportItem [] (_, _, _) = "" +formatBalanceReportItem (fmt:fmts) (macctname, depth, amount) = + format fmt (macctname, depth, amount) ++ + formatBalanceReportItem fmts (macctname, depth, amount) where - s = case fmt of - FormatLiteral l -> l - FormatField ljust min max field -> formatField opts accountName depth amount ljust min max field - -formatField :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String -formatField opts accountName depth total ljust min max field = case field of - AccountField -> formatValue ljust min max $ maybe "" (maybeAccountNameDrop opts) accountName - DepthSpacerField -> case min of - Just m -> formatValue ljust Nothing max $ replicate (depth * m) ' ' - Nothing -> formatValue ljust Nothing max $ replicate depth ' ' - TotalField -> formatValue ljust min max $ showAmountWithoutPrice total - _ -> "" + format :: StringFormat -> (Maybe AccountName, Int, Amount) -> String + format (FormatLiteral s) _ = s + format (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 diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index ab22e4378..ddca7c0e0 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -81,7 +81,7 @@ import Test.HUnit import Text.Parsec import Hledger -import Hledger.Data.OutputFormat as OutputFormat +import Hledger.Data.StringFormat as StringFormat import Hledger.Cli.Version @@ -467,11 +467,11 @@ maybeAccountNameDrop opts a | tree_ opts = a -- | Parse the format option if provided, possibly returning an error, -- otherwise get the default value. -lineFormatFromOpts :: ReportOpts -> Either String [OutputFormat] +lineFormatFromOpts :: ReportOpts -> Either String [StringFormat] lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_ -- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)" -defaultBalanceLineFormat :: [OutputFormat] +defaultBalanceLineFormat :: [StringFormat] defaultBalanceLineFormat = [ FormatField False (Just 20) Nothing TotalField , FormatLiteral " "