{-# LANGUAGE OverloadedStrings #-}
module Hledger.Data.Errors (
makeTransactionErrorExcerpt,
makePostingErrorExcerpt,
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.Types
import Hledger.Utils
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)
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
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 (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
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
tcommentlines :: Int
tcommentlines = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcomment Transaction
t) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
mpindex :: Maybe Int
mpindex = (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex (Posting -> Posting -> Bool
forall a. Eq a => a -> a -> Bool
==Posting
p) Transaction
t
errrelline :: Int
errrelline = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
tcommentlinesInt -> Int -> Int
forall a. Num a => a -> a -> a
+) Maybe Int
mpindex
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
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 (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 (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
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 (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