1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
{-|
Helpers for making error messages.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Data.Errors (
makeAccountTagErrorExcerpt,
makePriceDirectiveErrorExcerpt,
makeTransactionErrorExcerpt,
makePostingErrorExcerpt,
makePostingAccountErrorExcerpt,
makeBalanceAssertionErrorExcerpt,
transactionFindPostingIndex,
)
where
import Data.Function ((&))
import Data.List (find)
import Data.Text (Text)
import qualified Data.Text as T
import Hledger.Data.Transaction (showTransaction)
import Hledger.Data.Posting (postingStripCosts)
import Hledger.Data.Types
import Hledger.Utils
import Data.Maybe
import Safe (headMay)
import Hledger.Data.Posting (isVirtual)
import Hledger.Data.Dates (showDate)
import Hledger.Data.Amount (showCommoditySymbol, showAmount)
-- | Given an account name and its account directive, and a problem tag within the latter:
-- render it as a megaparsec-style excerpt, showing the original line number and
-- marked column or region.
-- Returns the file path, line number, column(s) if known,
-- and the rendered excerpt, or as much of these as is possible.
-- The returned columns will be accurate for the rendered error message but not for the original journal data.
makeAccountTagErrorExcerpt :: (AccountName, AccountDeclarationInfo) -> TagName -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeAccountTagErrorExcerpt (a, adi) _t = (f, l, merrcols, ex)
-- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
where
SourcePos f pos _ = adisourcepos adi
l = unPos pos
txt = showAccountDirective (a, adi) & textChomp & (<>"\n")
ex = decorateExcerpt l merrcols txt
-- Calculate columns which will help highlight the region in the excerpt
-- (but won't exactly match the real data, so won't be shown in the main error line)
merrcols = Nothing
-- don't bother for now
-- Just (col, Just col2)
-- where
-- col = undefined -- T.length (showTransactionLineFirstPart t') + 2
-- col2 = undefined -- col + T.length tagname - 1
showAccountDirective (a, AccountDeclarationInfo{..}) =
"account " <> a
<> (if not $ T.null adicomment then " ; " <> adicomment else "")
-- | Decorate a data excerpt with megaparsec-style left margin, line number,
-- and marker/underline for the column(s) if known, for inclusion in an error message.
decorateExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateExcerpt l mcols txt =
T.unlines $ ls' <> colmarkerline <> map (lineprefix<>) ms
where
(ls,ms) = splitAt 1 $ T.lines txt
ls' = map ((T.pack (show l) <> " | ") <>) ls
colmarkerline =
[lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"
| Just (col, mendcol) <- [mcols]
, let regionw = maybe 1 (subtract col) mendcol + 1
]
lineprefix = T.replicate marginw " " <> "| "
where marginw = length (show l) + 1
-- | Given a problem price directive,
-- and maybe a function to calculate the error region's column(s) (currently ignored):
-- generate a megaparsec-style error message with highlighted excerpt.
-- Returns the source file path, line number, column(s) if known, and the rendered excerpt,
-- or as much of these as possible.
-- Columns will be accurate for the rendered error message, not for the original journal entry.
makePriceDirectiveErrorExcerpt :: PriceDirective -> Maybe (PriceDirective -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePriceDirectiveErrorExcerpt pd _finderrorcolumns = (file, line, merrcols, excerpt)
where
SourcePos file pos _ = pdsourcepos pd
line = unPos pos
merrcols = Nothing
excerpt = decorateExcerpt line merrcols $ showPriceDirective pd <> "\n"
showPriceDirective :: PriceDirective -> Text
showPriceDirective PriceDirective{..} = T.unwords [
"P"
,showDate pddate
,showCommoditySymbol pdcommodity
,T.pack $ showAmount pdamount
]
-- | Given a problem transaction and a function calculating the best
-- column(s) for marking the error region:
-- render it as a megaparsec-style excerpt, showing the original line number
-- on the transaction line, and a column(s) marker.
-- Returns the file path, line number, column(s) if known,
-- and the rendered excerpt, or as much of these as is possible.
-- The returned columns will be accurate for the rendered error message but not for the original journal data.
makeTransactionErrorExcerpt :: Transaction -> (Transaction -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeTransactionErrorExcerpt t findtxnerrorcolumns = (f, tl, merrcols, ex)
-- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
where
SourcePos f tpos _ = fst $ tsourcepos t
tl = unPos tpos
txntxt = showTransaction t & textChomp & (<>"\n")
merrcols = findtxnerrorcolumns t
ex = decorateTransactionErrorExcerpt tl merrcols txntxt
-- | Add megaparsec-style left margin, line number, and optional column marker(s).
decorateTransactionErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateTransactionErrorExcerpt l mcols txt =
T.unlines $ ls' <> colmarkerline <> map (lineprefix<>) ms
where
(ls,ms) = splitAt 1 $ T.lines txt
ls' = map ((T.pack (show l) <> " | ") <>) ls
colmarkerline =
[lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"
| Just (col, mendcol) <- [mcols]
, let regionw = maybe 1 (subtract col) mendcol + 1
]
lineprefix = T.replicate marginw " " <> "| "
where marginw = length (show l) + 1
-- | Given a problem posting and a function calculating the best
-- column(s) for marking the error region:
-- look up error info from the parent transaction, and render the transaction
-- as a megaparsec-style excerpt, showing the original line number
-- on the problem posting's line, and a column indicator.
-- Returns the file path, line number, column(s) if known,
-- and the rendered excerpt, or as much of these as is possible.
-- A limitation: columns will be accurate for the rendered error message but not for the original journal data.
makePostingErrorExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingErrorExcerpt p findpostingerrorcolumns =
case ptransaction p of
Nothing -> ("-", 0, Nothing, "")
Just t -> (f, errabsline, merrcols, ex)
where
(SourcePos f tl _) = fst $ tsourcepos t
-- p had cost removed in balanceTransactionAndCheckAssertionsB,
-- must remove them from t's postings too (#2083)
mpindex = transactionFindPostingIndex ((==p).postingStripCosts) t
errrelline = case mpindex of
Nothing -> 0
Just pindex ->
commentExtraLines (tcomment t) +
sum (map postingLines $ take pindex $ tpostings t)
where
-- How many lines are used to render this posting ?
postingLines p' = 1 + commentExtraLines (pcomment p')
-- How many extra lines does this comment add to a transaction or posting rendering ?
commentExtraLines c = max 0 (length (T.lines c) - 1)
errabsline = unPos tl + errrelline
txntxt = showTransaction t & textChomp & (<>"\n")
merrcols = findpostingerrorcolumns p t txntxt
ex = decoratePostingErrorExcerpt errabsline errrelline merrcols txntxt
-- | Add megaparsec-style left margin, line number, and optional column marker(s).
decoratePostingErrorExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text
decoratePostingErrorExcerpt absline relline mcols txt =
T.unlines $ js' <> ks' <> colmarkerline <> ms'
where
(ls,ms) = splitAt (relline+1) $ T.lines txt
(js,ks) = splitAt (length ls - 1) ls
(js',ks') = case ks of
[k] -> (map (lineprefix<>) js, [T.pack (show absline) <> " | " <> k])
_ -> ([], [])
ms' = map (lineprefix<>) ms
colmarkerline =
[lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"
| Just (col, mendcol) <- [mcols]
, let regionw = 1 + maybe 0 (subtract col) mendcol
]
lineprefix = T.replicate marginw " " <> "| "
where marginw = length (show absline) + 1
-- | Find the 1-based index of the first posting in this transaction
-- satisfying the given predicate.
transactionFindPostingIndex :: (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex ppredicate =
fmap fst . find (ppredicate.snd) . zip [1..] . tpostings
-- | From the given posting, make an error excerpt showing the transaction with
-- this posting's account part highlighted.
makePostingAccountErrorExcerpt :: Posting -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingAccountErrorExcerpt p = makePostingErrorExcerpt p finderrcols
where
-- Calculate columns suitable for highlighting the synthetic excerpt.
finderrcols p' _ _ = Just (col, Just col2)
where
col = 5 + if isVirtual p' then 1 else 0
col2 = col + T.length (paccount p') - 1
-- | From the given posting, make an error excerpt showing the transaction with
-- the balance assertion highlighted.
makeBalanceAssertionErrorExcerpt :: Posting -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeBalanceAssertionErrorExcerpt p = makePostingErrorExcerpt p finderrcols
where
finderrcols p' t trendered = Just (col, Just col2)
where
-- Analyse the rendering to find the columns to highlight.
tlines = dbg5 "tlines" $ max 1 $ length $ T.lines $ tcomment t -- transaction comment can generate extra lines
(col, col2) =
let def = (5, maximum (map T.length $ T.lines trendered)) -- fallback: underline whole posting. Shouldn't happen.
in
case transactionFindPostingIndex (==p') t of
Nothing -> def
Just idx -> fromMaybe def $ do
let
beforeps = take (idx-1) $ tpostings t
beforepslines = dbg5 "beforepslines" $ sum $ map (max 1 . length . T.lines . pcomment) beforeps -- posting comment can generate extra lines (assume only one commodity shown)
assertionline <- dbg5 "assertionline" $ headMay $ drop (tlines + beforepslines) $ T.lines trendered
let
col2' = T.length assertionline
l = dropWhile (/= '=') $ reverse $ T.unpack assertionline
l' = dropWhile (`elem` ['=','*']) l
col' = length l' + 1
return (col', col2')
|
