1-- | Parse format strings provided by --format, with awareness of 2-- hledger's report item fields. The formats are used by 3-- report-specific renderers like renderBalanceReportItem. 4 5{-# LANGUAGE FlexibleContexts, OverloadedStrings, TypeFamilies, PackageImports #-} 6 7module Hledger.Data.StringFormat ( 8 parseStringFormat 9 , defaultStringFormatStyle 10 , StringFormat(..) 11 , StringFormatComponent(..) 12 , ReportItemField(..) 13 , tests_StringFormat 14 ) where 15 16import Prelude () 17import "base-compat-batteries" Prelude.Compat 18import Numeric 19import Data.Char (isPrint) 20import Data.Maybe 21-- import qualified Data.Text as T 22import Text.Megaparsec 23import Text.Megaparsec.Char 24 25import Hledger.Utils.Parse 26import Hledger.Utils.String (formatString) 27import Hledger.Utils.Test 28 29-- | A format specification/template to use when rendering a report line item as text. 30-- 31-- A format is a sequence of components; each is either a literal 32-- string, or a hledger report item field with specified width and 33-- justification whose value will be interpolated at render time. 34-- 35-- A component's value may be a multi-line string (or a 36-- multi-commodity amount), in which case the final string will be 37-- either single-line or a top or bottom-aligned multi-line string 38-- depending on the StringFormat variant used. 39-- 40-- Currently this is only used in the balance command's single-column 41-- mode, which provides a limited StringFormat renderer. 42-- 43data StringFormat = 44 OneLine [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated 45 | TopAligned [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height) 46 | BottomAligned [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded) 47 deriving (Show, Eq) 48 49data StringFormatComponent = 50 FormatLiteral String -- ^ Literal text to be rendered as-is 51 | FormatField Bool 52 (Maybe Int) 53 (Maybe Int) 54 ReportItemField -- ^ A data field to be formatted and interpolated. Parameters: 55 -- 56 -- - Left justify ? Right justified if false 57 -- - Minimum width ? Will be space-padded if narrower than this 58 -- - Maximum width ? Will be clipped if wider than this 59 -- - Which of the standard hledger report item fields to interpolate 60 deriving (Show, Eq) 61 62-- | An id identifying which report item field to interpolate. These 63-- are drawn from several hledger report types, so are not all 64-- applicable for a given report. 65data ReportItemField = 66 AccountField -- ^ A posting or balance report item's account name 67 | DefaultDateField -- ^ A posting or register or entry report item's date 68 | DescriptionField -- ^ A posting or register or entry report item's description 69 | TotalField -- ^ A balance or posting report item's balance or running total. 70 -- Always rendered right-justified. 71 | DepthSpacerField -- ^ A balance report item's indent level (which may be different from the account name depth). 72 -- Rendered as this number of spaces, multiplied by the minimum width spec if any. 73 | FieldNo Int -- ^ A report item's nth field. May be unimplemented. 74 deriving (Show, Eq) 75 76---------------------------------------------------------------------- 77 78-- renderStringFormat :: StringFormat -> Map String String -> String 79-- renderStringFormat fmt params = 80 81---------------------------------------------------------------------- 82 83-- | Parse a string format specification, or return a parse error. 84parseStringFormat :: String -> Either String StringFormat 85parseStringFormat input = case (runParser (stringformatp <* eof) "(unknown)") input of 86 Left y -> Left $ show y 87 Right x -> Right x 88 89defaultStringFormatStyle = BottomAligned 90 91stringformatp :: SimpleStringParser StringFormat 92stringformatp = do 93 alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String)) 94 let constructor = 95 case alignspec of 96 Just '^' -> TopAligned 97 Just '_' -> BottomAligned 98 Just ',' -> OneLine 99 _ -> defaultStringFormatStyle 100 constructor <$> many componentp 101 102componentp :: SimpleStringParser StringFormatComponent 103componentp = formatliteralp <|> formatfieldp 104 105formatliteralp :: SimpleStringParser StringFormatComponent 106formatliteralp = do 107 s <- some c 108 return $ FormatLiteral s 109 where 110 isPrintableButNotPercentage x = isPrint x && x /= '%' 111 c = (satisfy isPrintableButNotPercentage <?> "printable character") 112 <|> try (string "%%" >> return '%') 113 114formatfieldp :: SimpleStringParser StringFormatComponent 115formatfieldp = do 116 char '%' 117 leftJustified <- optional (char '-') 118 minWidth <- optional (some $ digitChar) 119 maxWidth <- optional (do char '.'; some $ digitChar) -- TODO: Can this be (char '1') *> (some digitChar) 120 char '(' 121 f <- fieldp 122 char ')' 123 return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f 124 where 125 parseDec s = case s of 126 Just text -> Just m where ((m,_):_) = readDec text 127 _ -> Nothing 128 129fieldp :: SimpleStringParser ReportItemField 130fieldp = do 131 try (string "account" >> return AccountField) 132 <|> try (string "depth_spacer" >> return DepthSpacerField) 133 <|> try (string "date" >> return DescriptionField) 134 <|> try (string "description" >> return DescriptionField) 135 <|> try (string "total" >> return TotalField) 136 <|> try ((FieldNo . read) <$> some digitChar) 137 138---------------------------------------------------------------------- 139 140formatStringTester fs value expected = actual @?= expected 141 where 142 actual = case fs of 143 FormatLiteral l -> formatString False Nothing Nothing l 144 FormatField leftJustify min max _ -> formatString leftJustify min max value 145 146tests_StringFormat = tests "StringFormat" [ 147 148 test "formatStringHelper" $ do 149 formatStringTester (FormatLiteral " ") "" " " 150 formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description" 151 formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description" 152 formatStringTester (FormatField False Nothing (Just 20) DescriptionField) "description" "description" 153 formatStringTester (FormatField True Nothing (Just 20) DescriptionField) "description" "description" 154 formatStringTester (FormatField True (Just 20) Nothing DescriptionField) "description" "description " 155 formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description " 156 formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des" 157 158 ,let s `gives` expected = test s $ parseStringFormat s @?= Right expected 159 in tests "parseStringFormat" [ 160 "" `gives` (defaultStringFormatStyle []) 161 , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) 162 , "%(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField]) 163 , "%(total)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField]) 164 -- TODO 165 -- , "^%(total)" `gives` (TopAligned [FormatField False Nothing Nothing TotalField]) 166 -- , "_%(total)" `gives` (BottomAligned [FormatField False Nothing Nothing TotalField]) 167 -- , ",%(total)" `gives` (OneLine [FormatField False Nothing Nothing TotalField]) 168 , "Hello %(date)!" `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]) 169 , "%-(date)" `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField]) 170 , "%20(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField]) 171 , "%.10(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField]) 172 , "%20.10(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField]) 173 , "%20(account) %.10(total)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField 174 ,FormatLiteral " " 175 ,FormatField False Nothing (Just 10) TotalField 176 ]) 177 , test "newline not parsed" $ assertLeft $ parseStringFormat "\n" 178 ] 179 ] 180