{-|
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 :: (Text, AccountDeclarationInfo)
-> Text -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeAccountTagErrorExcerpt (Text
a, AccountDeclarationInfo
adi) Text
_t = (FilePath
f, Int
l, Maybe (Int, Maybe Int)
forall {a}. Maybe a
merrcols, Text
ex)
  -- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
  where
    SourcePos FilePath
f Pos
pos Pos
_ = AccountDeclarationInfo -> SourcePos
adisourcepos AccountDeclarationInfo
adi
    l :: Int
l = Pos -> Int
unPos Pos
pos
    txt :: Text
txt   = (Text, AccountDeclarationInfo) -> Text
showAccountDirective (Text
a, AccountDeclarationInfo
adi) Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
textChomp Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")
    ex :: Text
ex = Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateExcerpt Int
l Maybe (Int, Maybe Int)
forall {a}. Maybe a
merrcols Text
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 :: Maybe a
merrcols = Maybe a
forall {a}. Maybe a
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 :: (Text, AccountDeclarationInfo) -> Text
showAccountDirective (Text
a, AccountDeclarationInfo{Int
[Tag]
Text
SourcePos
adisourcepos :: AccountDeclarationInfo -> SourcePos
adicomment :: Text
aditags :: [Tag]
adideclarationorder :: Int
adisourcepos :: SourcePos
adicomment :: AccountDeclarationInfo -> Text
aditags :: AccountDeclarationInfo -> [Tag]
adideclarationorder :: AccountDeclarationInfo -> Int
..}) =
  Text
"account " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
adicomment then Text
"    ; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
adicomment else Text
"")

-- | 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 :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateExcerpt Int
l Maybe (Int, Maybe Int)
mcols Text
txt =
  [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
ls' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
colmarkerline [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
lineprefixText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
ms
  where
    ([Text]
ls,[Text]
ms) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
txt
    ls' :: [Text]
ls' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
ls
    colmarkerline :: [Text]
colmarkerline =
      [Text
lineprefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
colInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
regionw Text
"^"
      | Just (Int
col, Maybe Int
mendcol) <- [Maybe (Int, Maybe Int)
mcols]
      , let regionw :: Int
regionw = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
col) Maybe Int
mendcol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      ]
    lineprefix :: Text
lineprefix = Int -> Text -> Text
T.replicate Int
marginw Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| "
      where  marginw :: Int
marginw = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: PriceDirective
-> Maybe (PriceDirective -> Text -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePriceDirectiveErrorExcerpt PriceDirective
pd Maybe (PriceDirective -> Text -> Maybe (Int, Maybe Int))
_finderrorcolumns = (FilePath
file, Int
line, Maybe (Int, Maybe Int)
forall {a}. Maybe a
merrcols, Text
excerpt)
  where
    SourcePos FilePath
file Pos
pos Pos
_ = PriceDirective -> SourcePos
pdsourcepos PriceDirective
pd
    line :: Int
line = Pos -> Int
unPos Pos
pos
    merrcols :: Maybe a
merrcols = Maybe a
forall {a}. Maybe a
Nothing
    excerpt :: Text
excerpt = Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateExcerpt Int
line Maybe (Int, Maybe Int)
forall {a}. Maybe a
merrcols (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ PriceDirective -> Text
showPriceDirective PriceDirective
pd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

showPriceDirective :: PriceDirective -> Text
showPriceDirective :: PriceDirective -> Text
showPriceDirective PriceDirective{Text
SourcePos
Day
Amount
pdsourcepos :: PriceDirective -> SourcePos
pdsourcepos :: SourcePos
pddate :: Day
pdcommodity :: Text
pdamount :: Amount
pddate :: PriceDirective -> Day
pdcommodity :: PriceDirective -> Text
pdamount :: PriceDirective -> Amount
..} = [Text] -> Text
T.unwords [
   Text
"P"
  ,Day -> Text
showDate Day
pddate
  ,Text -> Text
showCommoditySymbol Text
pdcommodity
  ,FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Amount -> FilePath
showAmount Amount
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 :: Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeTransactionErrorExcerpt Transaction
t Transaction -> Maybe (Int, Maybe Int)
findtxnerrorcolumns = (FilePath
f, Int
tl, Maybe (Int, Maybe Int)
merrcols, Text
ex)
  -- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
  where
    SourcePos FilePath
f Pos
tpos Pos
_ = (SourcePos, SourcePos) -> SourcePos
forall a b. (a, b) -> a
fst ((SourcePos, SourcePos) -> SourcePos)
-> (SourcePos, SourcePos) -> SourcePos
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t
    tl :: Int
tl = Pos -> Int
unPos Pos
tpos
    txntxt :: Text
txntxt = Transaction -> Text
showTransaction Transaction
t Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
textChomp Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")
    merrcols :: Maybe (Int, Maybe Int)
merrcols = Transaction -> Maybe (Int, Maybe Int)
findtxnerrorcolumns Transaction
t
    ex :: Text
ex = Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateTransactionErrorExcerpt Int
tl Maybe (Int, Maybe Int)
merrcols Text
txntxt

-- | Add megaparsec-style left margin, line number, and optional column marker(s).
decorateTransactionErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateTransactionErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateTransactionErrorExcerpt Int
l Maybe (Int, Maybe Int)
mcols Text
txt =
  [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
ls' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
colmarkerline [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
lineprefixText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
ms
  where
    ([Text]
ls,[Text]
ms) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
txt
    ls' :: [Text]
ls' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
ls
    colmarkerline :: [Text]
colmarkerline =
      [Text
lineprefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
colInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
regionw Text
"^"
      | Just (Int
col, Maybe Int
mendcol) <- [Maybe (Int, Maybe Int)
mcols]
      , let regionw :: Int
regionw = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
col) Maybe Int
mendcol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      ]
    lineprefix :: Text
lineprefix = Int -> Text -> Text
T.replicate Int
marginw Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| "
      where  marginw :: Int
marginw = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Posting
-> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingErrorExcerpt Posting
p Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
findpostingerrorcolumns =
  case Posting -> Maybe Transaction
ptransaction Posting
p of
    Maybe Transaction
Nothing -> (FilePath
"-", Int
0, Maybe (Int, Maybe Int)
forall {a}. Maybe a
Nothing, Text
"")
    Just Transaction
t  -> (FilePath
f, Int
errabsline, Maybe (Int, Maybe Int)
merrcols, Text
ex)
      where
        (SourcePos FilePath
f Pos
tl Pos
_) = (SourcePos, SourcePos) -> SourcePos
forall a b. (a, b) -> a
fst ((SourcePos, SourcePos) -> SourcePos)
-> (SourcePos, SourcePos) -> SourcePos
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t
        -- p had cost removed in balanceTransactionAndCheckAssertionsB,
        -- must remove them from t's postings too (#2083)
        mpindex :: Maybe Int
mpindex = (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex ((Posting -> Posting -> Bool
forall a. Eq a => a -> a -> Bool
==Posting
p)(Posting -> Bool) -> (Posting -> Posting) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> Posting
postingStripCosts) Transaction
t
        errrelline :: Int
errrelline = case Maybe Int
mpindex of
          Maybe Int
Nothing -> Int
0
          Just Int
pindex ->
            Text -> Int
commentExtraLines (Transaction -> Text
tcomment Transaction
t) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 
            [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Posting -> Int) -> [Posting] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Int
postingLines ([Posting] -> [Int]) -> [Posting] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [Posting] -> [Posting]
forall a. Int -> [a] -> [a]
take Int
pindex ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
            where
              -- How many lines are used to render this posting ?
              postingLines :: Posting -> Int
postingLines Posting
p' = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
commentExtraLines (Posting -> Text
pcomment Posting
p')
              -- How many extra lines does this comment add to a transaction or posting rendering ?
              commentExtraLines :: Text -> Int
commentExtraLines Text
c = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
T.lines Text
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        errabsline :: Int
errabsline = Pos -> Int
unPos Pos
tl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
errrelline
        txntxt :: Text
txntxt = Transaction -> Text
showTransaction Transaction
t Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
textChomp Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")
        merrcols :: Maybe (Int, Maybe Int)
merrcols = Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
findpostingerrorcolumns Posting
p Transaction
t Text
txntxt
        ex :: Text
ex = Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text
decoratePostingErrorExcerpt Int
errabsline Int
errrelline Maybe (Int, Maybe Int)
merrcols Text
txntxt

-- | Add megaparsec-style left margin, line number, and optional column marker(s).
decoratePostingErrorExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text
decoratePostingErrorExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text
decoratePostingErrorExcerpt Int
absline Int
relline Maybe (Int, Maybe Int)
mcols Text
txt =
  [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
js' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ks' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
colmarkerline [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ms'
  where
    ([Text]
ls,[Text]
ms) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
rellineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
txt
    ([Text]
js,[Text]
ks) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
ls
    ([Text]
js',[Text]
ks') = case [Text]
ks of
      [Text
k] -> ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
lineprefixText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
js, [FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
absline) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k])
      [Text]
_   -> ([], [])
    ms' :: [Text]
ms' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
lineprefixText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
ms
    colmarkerline :: [Text]
colmarkerline =
      [Text
lineprefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
colInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
regionw Text
"^"
      | Just (Int
col, Maybe Int
mendcol) <- [Maybe (Int, Maybe Int)
mcols]
      , let regionw :: Int
regionw = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
col) Maybe Int
mendcol
      ]
    lineprefix :: Text
lineprefix = Int -> Text -> Text
T.replicate Int
marginw Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| "
      where  marginw :: Int
marginw = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
absline) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Find the 1-based index of the first posting in this transaction
-- satisfying the given predicate.
transactionFindPostingIndex :: (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex :: (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex Posting -> Bool
ppredicate = 
  ((Int, Posting) -> Int) -> Maybe (Int, Posting) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Posting) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Posting) -> Maybe Int)
-> (Transaction -> Maybe (Int, Posting))
-> Transaction
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Posting) -> Bool)
-> [(Int, Posting)] -> Maybe (Int, Posting)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Posting -> Bool
ppredicate(Posting -> Bool)
-> ((Int, Posting) -> Posting) -> (Int, Posting) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int, Posting) -> Posting
forall a b. (a, b) -> b
snd) ([(Int, Posting)] -> Maybe (Int, Posting))
-> (Transaction -> [(Int, Posting)])
-> Transaction
-> Maybe (Int, Posting)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Posting] -> [(Int, Posting)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([Posting] -> [(Int, Posting)])
-> (Transaction -> [Posting]) -> Transaction -> [(Int, Posting)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
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 :: Posting -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingAccountErrorExcerpt Posting
p = Posting
-> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingErrorExcerpt Posting
p Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
forall {p} {p}. Posting -> p -> p -> Maybe (Int, Maybe Int)
finderrcols
  where
    -- Calculate columns suitable for highlighting the synthetic excerpt.
    finderrcols :: Posting -> p -> p -> Maybe (Int, Maybe Int)
finderrcols Posting
p' p
_ p
_ = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
col, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
col2)
      where
        col :: Int
col = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Posting -> Bool
isVirtual Posting
p' then Int
1 else Int
0
        col2 :: Int
col2 = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length (Posting -> Text
paccount Posting
p') Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Posting -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeBalanceAssertionErrorExcerpt Posting
p = Posting
-> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingErrorExcerpt Posting
p Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
finderrcols
  where
    finderrcols :: Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
finderrcols Posting
p' Transaction
t Text
trendered = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
col, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
col2)
      where
        -- Analyse the rendering to find the columns to highlight.
        tlines :: Int
tlines = FilePath -> Int -> Int
forall a. Show a => FilePath -> a -> a
dbg5 FilePath
"tlines" (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcomment Transaction
t  -- transaction comment can generate extra lines
        (Int
col, Int
col2) =
          let def :: (Int, Int)
def = (Int
5, [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length ([Text] -> [Int]) -> [Text] -> [Int]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
trendered))  -- fallback: underline whole posting. Shouldn't happen.
          in
            case (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex (Posting -> Posting -> Bool
forall a. Eq a => a -> a -> Bool
==Posting
p') Transaction
t of
              Maybe Int
Nothing  -> (Int, Int)
def
              Just Int
idx -> (Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (Int, Int)
def (Maybe (Int, Int) -> (Int, Int)) -> Maybe (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
                let
                  beforeps :: [Posting]
beforeps = Int -> [Posting] -> [Posting]
forall a. Int -> [a] -> [a]
take (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
                  beforepslines :: Int
beforepslines = FilePath -> Int -> Int
forall a. Show a => FilePath -> a -> a
dbg5 FilePath
"beforepslines" (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Posting -> Int) -> [Posting] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> (Posting -> Int) -> Posting -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> (Posting -> [Text]) -> Posting -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> (Posting -> Text) -> Posting -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Text
pcomment) [Posting]
beforeps   -- posting comment can generate extra lines (assume only one commodity shown)
                Text
assertionline <- FilePath -> Maybe Text -> Maybe Text
forall a. Show a => FilePath -> a -> a
dbg5 FilePath
"assertionline" (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
tlines Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
beforepslines) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
trendered
                let
                  col2' :: Int
col2' = Text -> Int
T.length Text
assertionline
                  l :: FilePath
l = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
assertionline
                  l' :: FilePath
l' = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'=',Char
'*']) FilePath
l
                  col' :: Int
col' = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
col', Int
col2')