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