diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index c3634bab9..300a8db6b 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -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. diff --git a/hledger-lib/Hledger/Data/Errors.hs b/hledger-lib/Hledger/Data/Errors.hs index c398b2544..419aaed66 100644 --- a/hledger-lib/Hledger/Data/Errors.hs +++ b/hledger-lib/Hledger/Data/Errors.hs @@ -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) +