simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-12-28 04:46:31 +03:00
Code Issues Projects Releases Wiki Activity

api: Hledger.Data.Errors: export makeBalanceAssertionErrorExcerpt

Browse Source
This commit is contained in:
Simon Michael 2022-07-29 09:01:34 +01:00
parent a6edbe4336
commit d860d6d2fc
2 changed files with 31 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
hledger-lib/Hledger/Data/Balancing.hs
View File

@ -42,7 +42,7 @@ import qualified Data.Set as S
import qualified Data.Text as T
import Data.Time.Calendar (fromGregorian)
import qualified Data.Map as M
import Safe (headDef, headMay)
import Safe (headDef)
import Text.Printf (printf)
import Hledger.Utils
@ -628,29 +628,7 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
acct = T.unpack $ paccount p
ass = fromJust $ pbalanceassertion p -- PARTIAL: fromJust won't fail, there is a balance assertion
pos = baposition ass
(_,_,_,ex) = 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)
(_,_,_,ex) = makeBalanceAssertionErrorExcerpt p
unless pass $ throwError errmsg
-- | Throw an error if this posting is trying to do an illegal balance assignment.

29
hledger-lib/Hledger/Data/Errors.hs
View File

@ -7,6 +7,7 @@ Helpers for making error messages.
module Hledger.Data.Errors (
makeTransactionErrorExcerpt,
makePostingErrorExcerpt,
makeBalanceAssertionErrorExcerpt,
transactionFindPostingIndex,
)
where
@ -19,6 +20,8 @@ import qualified Data.Text as T
import Hledger.Data.Transaction (showTransaction)
import Hledger.Data.Types
import Hledger.Utils
import Data.Maybe
import Safe (headMay)
-- | Given a problem transaction and a function calculating the best
-- column(s) for marking the error region:
@ -100,3 +103,29 @@ 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
-- 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)