slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib!: Remove GenericSourcePos, and replace it with either SourcePos or

Browse Source 
(SourcePos, SourcePos).

This has been marked for possible removal for a while. We are keeping
strictly more information. Possible edge cases arise with Timeclock and
CsvReader, but I think these are covered.

The particular motivation for getting rid of this is that
GenericSourcePos is creating some awkward import considerations for
little gain. Removing this enables some flattening of the module
dependency tree.
This commit is contained in:
Stephen Morgan 2021-08-25 13:04:28 +10:00 committed by Simon Michael
parent 04b17e00c4
commit 4cfd3cb590
18 changed files with 92 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -169,7 +169,7 @@ transactionBalanceError t errs =
annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction t s =
unlines [ showGenericSourcePos $ tsourcepos t, s
unlines [ showSourcePosPair $ tsourcepos t, s
, T.unpack . T.stripEnd $ showTransaction t
]
@ -586,7 +586,7 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
(case ptransaction p of
Nothing -> "?" -- shouldn't happen
Just t -> printf "%s\ntransaction:\n%s"
(showGenericSourcePos pos)
(showSourcePos pos)
(textChomp $ showTransaction t)
:: String
where

14
hledger-lib/Hledger/Data/Json.hs
View File

@ -24,6 +24,7 @@ import Data.Decimal (DecimalRaw(..), roundTo)
import Data.Maybe (fromMaybe)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Text.Megaparsec (Pos, SourcePos, mkPos, unPos)
import Hledger.Data.Types
import Hledger.Data.Amount (amountsRaw, mixed)
@ -31,7 +32,12 @@ import Hledger.Data.Amount (amountsRaw, mixed)
-- To JSON
instance ToJSON Status
instance ToJSON GenericSourcePos
instance ToJSON SourcePos
-- Use the same encoding as the underlying Int
instance ToJSON Pos where
toJSON = toJSON . unPos
toEncoding = toEncoding . unPos
-- https://github.com/simonmichael/hledger/issues/1195
@ -159,7 +165,11 @@ instance ToJSON Ledger
-- From JSON
instance FromJSON Status
instance FromJSON GenericSourcePos
instance FromJSON SourcePos
-- Use the same encoding as the underlying Int
instance FromJSON Pos where
parseJSON = fmap mkPos . parseJSON
instance FromJSON Amount
instance FromJSON AmountStyle

6
hledger-lib/Hledger/Data/Posting.hs
View File

@ -125,15 +125,15 @@ post' acc amt ass = posting {paccount=acc, pamount=mixedAmount amt, pbalanceasse
vpost' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' acc amt ass = (post' acc amt ass){ptype=VirtualPosting, pbalanceassertion=ass}
nullsourcepos :: GenericSourcePos
nullsourcepos = JournalSourcePos "" (1,1)
nullsourcepos :: (SourcePos, SourcePos)
nullsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
nullassertion :: BalanceAssertion
nullassertion = BalanceAssertion
{baamount=nullamt
,batotal=False
,bainclusive=False
,baposition=nullsourcepos
,baposition=initialPos ""
}
-- | Make a partial, exclusive balance assertion.

9
hledger-lib/Hledger/Data/Timeclock.hs
View File

@ -77,10 +77,7 @@ timeclockEntriesToTransactions now (i:o:rest)
{- HLINT ignore timeclockEntriesToTransactions -}
errorExpectedCodeButGot expected actual = errorWithSourceLine line $ "expected timeclock code " ++ (show expected) ++ " but got " ++ show (tlcode actual)
where
line = case tlsourcepos actual of
GenericSourcePos _ l _ -> l
JournalSourcePos _ (l, _) -> l
where line = unPos . sourceLine $ tlsourcepos actual
errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg
@ -95,7 +92,7 @@ entryFromTimeclockInOut i o
where
t = Transaction {
tindex = 0,
tsourcepos = tlsourcepos i,
tsourcepos = (tlsourcepos i, tlsourcepos i),
tdate = idate,
tdate2 = Nothing,
tstatus = Cleared,
@ -135,7 +132,7 @@ tests_Timeclock = testGroup "Timeclock" [
let now = utcToLocalTime tz now'
nowstr = showtime now
yesterday = prevday today
clockin = TimeclockEntry nullsourcepos In
clockin = TimeclockEntry (initialPos "") In
mktime d = LocalTime d . fromMaybe midnight .
parseTimeM True defaultTimeLocale "%H:%M:%S"
showtime = formatTime defaultTimeLocale "%H:%M"

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

@ -7,7 +7,6 @@ tags.
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@ -44,10 +43,6 @@ module Hledger.Data.Transaction
, showTransactionOneLineAmounts
-- showPostingLine
, showPostingLines
-- * GenericSourcePos
, sourceFilePath
, sourceFirstLine
, showGenericSourcePos
, transactionFile
-- * tests
, tests_Transaction
@ -71,22 +66,6 @@ import Hledger.Data.Amount
import Hledger.Data.Valuation
import Text.Tabular.AsciiWide
sourceFilePath :: GenericSourcePos -> FilePath
sourceFilePath = \case
GenericSourcePos fp _ _ -> fp
JournalSourcePos fp _ -> fp
sourceFirstLine :: GenericSourcePos -> Int
sourceFirstLine = \case
GenericSourcePos _ line _ -> line
JournalSourcePos _ (line, _) -> line
-- | Render source position in human-readable form.
-- Keep in sync with Hledger.UI.ErrorScreen.hledgerparseerrorpositionp (temporary). XXX
showGenericSourcePos :: GenericSourcePos -> String
showGenericSourcePos = \case
GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ ", column " ++ show column ++ ")"
JournalSourcePos fp (line, line') -> show fp ++ " (lines " ++ show line ++ "-" ++ show line' ++ ")"
nulltransaction :: Transaction
nulltransaction = Transaction {
@ -393,10 +372,7 @@ transactionMapPostingAmounts f = transactionMapPostings (postingTransformAmount
-- | The file path from which this transaction was parsed.
transactionFile :: Transaction -> FilePath
transactionFile Transaction{tsourcepos} =
case tsourcepos of
GenericSourcePos f _ _ -> f
JournalSourcePos f _ -> f
transactionFile Transaction{tsourcepos} = sourceName $ fst tsourcepos
-- tests

15
hledger-lib/Hledger/Data/Types.hs
View File

@ -31,7 +31,6 @@ import Data.Decimal (Decimal, DecimalRaw(..))
import Data.Default (Default(..))
import Data.Functor (($>))
import Data.List (intercalate)
import Text.Blaze (ToMarkup(..))
--XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html
--Note: You should use Data.Map.Strict instead of this module if:
--You will eventually need all the values stored.
@ -43,6 +42,8 @@ import Data.Time.Calendar (Day)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Time.LocalTime (LocalTime)
import Data.Word (Word8)
import Text.Blaze (ToMarkup(..))
import Text.Megaparsec (SourcePos)
import Hledger.Utils.Regex
@ -341,7 +342,7 @@ data BalanceAssertion = BalanceAssertion {
baamount :: Amount, -- ^ the expected balance in a particular commodity
batotal :: Bool, -- ^ disallow additional non-asserted commodities ?
bainclusive :: Bool, -- ^ include subaccounts when calculating the actual balance ?
baposition :: GenericSourcePos -- ^ the assertion's file position, for error reporting
baposition :: SourcePos -- ^ the assertion's file position, for error reporting
} deriving (Eq,Generic,Show)
data Posting = Posting {
@ -385,16 +386,10 @@ instance Show Posting where
,"poriginal=" ++ show poriginal
] ++ "}"
-- TODO: needs renaming, or removal if no longer needed. See also TextPosition in Hledger.UI.Editor
-- | The position of parse errors (eg), like parsec's SourcePos but generic.
data GenericSourcePos = GenericSourcePos FilePath Int Int -- ^ file path, 1-based line number and 1-based column number.
| JournalSourcePos FilePath (Int, Int) -- ^ file path, inclusive range of 1-based line numbers (first, last).
deriving (Eq, Read, Show, Ord, Generic)
data Transaction = Transaction {
tindex :: Integer, -- ^ this transaction's 1-based position in the transaction stream, or 0 when not available
tprecedingcomment :: Text, -- ^ any comment lines immediately preceding this transaction
tsourcepos :: GenericSourcePos, -- ^ the file position where the date starts
tsourcepos :: (SourcePos, SourcePos), -- ^ the file position where the date starts, and where the last posting ends
tdate :: Day,
tdate2 :: Maybe Day,
tstatus :: Status,
@ -458,7 +453,7 @@ nullperiodictransaction = PeriodicTransaction{
data TimeclockCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Generic)
data TimeclockEntry = TimeclockEntry {
tlsourcepos :: GenericSourcePos,
tlsourcepos :: SourcePos,
tlcode :: TimeclockCode,
tldatetime :: LocalTime,
tlaccount :: AccountName,

20
hledger-lib/Hledger/Read/Common.hs
View File

@ -35,8 +35,6 @@ module Hledger.Read.Common (
rawOptsToInputOpts,
-- * parsing utilities
genericSourcePos,
journalSourcePos,
parseAndFinaliseJournal,
parseAndFinaliseJournal',
journalFinalise,
@ -252,16 +250,6 @@ commodityStyleFromRawOpts rawOpts =
parseCommodity optStr = case amountp'' optStr of
Left _ -> Left optStr
Right (Amount acommodity _ astyle _) -> Right (acommodity, astyle)
genericSourcePos :: SourcePos -> GenericSourcePos
genericSourcePos p = GenericSourcePos (sourceName p) (unPos $ sourceLine p) (unPos $ sourceColumn p)
-- | Construct a generic start & end line parse position from start and end megaparsec SourcePos's.
journalSourcePos :: SourcePos -> SourcePos -> GenericSourcePos
journalSourcePos p p' = JournalSourcePos (sourceName p) (unPos $ sourceLine p, line')
where line' | (unPos $ sourceColumn p') == 1 = unPos (sourceLine p') - 1
| otherwise = unPos $ sourceLine p' -- might be at end of file withat last new-line
-- | Given a parser to ParsedJournal, input options, file path and
-- content: run the parser on the content, and finalise the result to
-- get a Journal; or throw an error.
@ -376,7 +364,7 @@ journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j
| otherwise = Left $
printf "undeclared payee \"%s\"\nat: %s\n\n%s"
(T.unpack p)
(showGenericSourcePos $ tsourcepos t)
(showSourcePosPair $ tsourcepos t)
(linesPrepend2 "> " " " . (<>"\n") . textChomp $ showTransaction t)
where
p = transactionPayee t
@ -394,7 +382,7 @@ journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j
++ case ptransaction of
Nothing -> ""
Just t -> printf "in transaction at: %s\n\n%s"
(showGenericSourcePos $ tsourcepos t)
(showSourcePosPair $ tsourcepos t)
(linesPrepend " " . (<>"\n") . textChomp $ showTransaction t)
where
as = journalAccountNamesDeclared j
@ -413,7 +401,7 @@ journalCheckCommoditiesDeclared j =
++ case ptransaction of
Nothing -> ""
Just t -> printf "in transaction at: %s\n\n%s"
(showGenericSourcePos $ tsourcepos t)
(showSourcePosPair $ tsourcepos t)
(linesPrepend " " . (<>"\n") . textChomp $ showTransaction t)
where
mfirstundeclaredcomm =
@ -908,7 +896,7 @@ priceamountp baseAmt = label "transaction price" $ do
balanceassertionp :: JournalParser m BalanceAssertion
balanceassertionp = do
sourcepos <- genericSourcePos <$> lift getSourcePos
sourcepos <- getSourcePos
char '='
istotal <- fmap isJust $ optional $ try $ char '='
isinclusive <- fmap isJust $ optional $ try $ char '*'

12
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -77,7 +77,7 @@ import Text.Printf (printf)
import Hledger.Data
import Hledger.Utils
import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, genericSourcePos, journalFinalise )
import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise )
--- ** doctest setup
-- $setup
@ -953,7 +953,7 @@ transactionFromCsvRecord sourcepos rules record = t
-- 4. Build the transaction (and name it, so the postings can reference it).
t = nulltransaction{
tsourcepos = genericSourcePos sourcepos -- the CSV line number
tsourcepos = (sourcepos, sourcepos) -- the CSV line number
,tdate = date'
,tdate2 = mdate2'
,tstatus = status
@ -1028,7 +1028,7 @@ getAmount rules record currency p1IsVirtual n =
-- | Figure out the expected balance (assertion or assignment) specified for posting N,
-- if any (and its parse position).
getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, GenericSourcePos)
getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, SourcePos)
getBalance rules record currency n = do
v <- (fieldval ("balance"<> T.pack (show n))
-- for posting 1, also recognise the old field name
@ -1037,7 +1037,7 @@ getBalance rules record currency n = do
"" -> Nothing
s -> Just (
parseBalanceAmount rules record currency n s
,nullsourcepos -- parse position to show when assertion fails,
,initialPos "" -- parse position to show when assertion fails,
) -- XXX the csv record's line number would be good
where
fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
@ -1101,7 +1101,7 @@ parseDecimalMark rules = do
-- possibly set by a balance-type rule.
-- The CSV rules and current record are also provided, to be shown in case
-- balance-type's argument is bad (XXX refactor).
mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, GenericSourcePos) -> BalanceAssertion
mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, SourcePos) -> BalanceAssertion
mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
where
assrt =
@ -1120,7 +1120,7 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
-- | Figure out the account name specified for posting N, if any.
-- And whether it is the default unknown account (which may be
-- improved later) or an explicitly set account (which may not).
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool)
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, SourcePos) -> Int -> Maybe (AccountName, Bool)
getAccount rules record mamount mbalance n =
let
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text

5
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -44,7 +44,6 @@ module Hledger.Read.JournalReader (
reader,
-- * Parsing utils
genericSourcePos,
parseAndFinaliseJournal,
runJournalParser,
rjp,
@ -696,7 +695,7 @@ transactionp = do
let year = first3 $ toGregorian date
postings <- postingsp (Just year)
endpos <- getSourcePos
let sourcepos = journalSourcePos startpos endpos
let sourcepos = (startpos, endpos)
return $ txnTieKnot $ Transaction 0 "" sourcepos date edate status code description comment tags postings
--- *** postings
@ -921,7 +920,7 @@ tests_JournalReader = testGroup "JournalReader" [
" ; ptag2: val2"
])
nulltransaction{
tsourcepos=JournalSourcePos "" (1,7), -- XXX why 7 here ?
tsourcepos=(SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 8) (mkPos 1)), -- 8 because there are 7 lines
tprecedingcomment="",
tdate=fromGregorian 2012 5 14,
tdate2=Just $ fromGregorian 2012 5 15,

2
hledger-lib/Hledger/Read/TimeclockReader.hs
View File

@ -119,7 +119,7 @@ timeclockfilep = do many timeclockitemp
-- | Parse a timeclock entry.
timeclockentryp :: JournalParser m TimeclockEntry
timeclockentryp = do
sourcepos <- genericSourcePos <$> lift getSourcePos
sourcepos <- getSourcePos
code <- oneOf ("bhioO" :: [Char])
lift skipNonNewlineSpaces1
datetime <- datetimep

4
hledger-lib/Hledger/Read/TimedotReader.hs
View File

@ -168,7 +168,7 @@ orgheadingprefixp = do
entryp :: JournalParser m Transaction
entryp = do
lift $ traceparse "entryp"
pos <- genericSourcePos <$> getSourcePos
pos <- getSourcePos
notFollowedBy datelinep
lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1]
a <- modifiedaccountnamep
@ -178,7 +178,7 @@ entryp = do
<|> (durationp <*
(try (lift followingcommentp) <|> (newline >> return "")))
let t = nulltransaction{
tsourcepos = pos,
tsourcepos = (pos, pos),
tstatus = Cleared,
tpostings = [
nullposting{paccount=a

20
hledger-lib/Hledger/Utils/Parse.hs
View File

@ -6,6 +6,15 @@ module Hledger.Utils.Parse (
SimpleTextParser,
TextParser,
SourcePos(..),
mkPos,
unPos,
initialPos,
-- * SourcePos
showSourcePosPair,
showSourcePos,
choice',
choiceInState,
surroundedBy,
@ -54,6 +63,17 @@ type SimpleTextParser = Parsec CustomErr Text -- XXX an "a" argument breaks the
-- | A parser of text that runs in some monad.
type TextParser m a = ParsecT CustomErr Text m a
-- | Render source position in human-readable form.
showSourcePos :: SourcePos -> String
showSourcePos (SourcePos fp l c) =
show fp ++ " (line " ++ show (unPos l) ++ ", column " ++ show (unPos c) ++ ")"
-- | Render a pair of source position in human-readable form.
showSourcePosPair :: (SourcePos, SourcePos) -> String
showSourcePosPair (SourcePos fp l1 _, SourcePos _ l2 c2) =
show fp ++ " (lines " ++ show (unPos l1) ++ "-" ++ show l2' ++ ")"
where l2' = if unPos c2 == 1 then unPos l2 - 1 else unPos l2 -- might be at end of file withat last new-line
-- | Backtracking choice, use this when alternatives share a prefix.
-- Consumes no input if all choices fail.
choice' :: [TextParser m a] -> TextParser m a

4
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -326,9 +326,7 @@ rsHandle ui@UIState{
(pos,f) = case listSelectedElement rsList of
Nothing -> (endPosition, journalFilePath j)
Just (_, RegisterScreenItem{
rsItemTransaction=Transaction{tsourcepos=GenericSourcePos f l c}}) -> (Just (l, Just c),f)
Just (_, RegisterScreenItem{
rsItemTransaction=Transaction{tsourcepos=JournalSourcePos f (l,_)}}) -> (Just (l, Nothing),f)
rsItemTransaction=Transaction{tsourcepos=(SourcePos f l c,_)}}) -> (Just (unPos l, Just $ unPos c),f)
-- display mode/query toggles
VtyEvent (EvKey (KChar 'B') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCost ui

3
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -158,8 +158,7 @@ tsHandle ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransaction
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
where
(pos,f) = case tsourcepos t of
GenericSourcePos f l c -> (Just (l, Just c),f)
JournalSourcePos f (l1,_) -> (Just (l1, Nothing),f)
(SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f)
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
where

2
hledger-web/Hledger/Web/Widget/Common.hs
View File

@ -112,7 +112,7 @@ transactionFragment j Transaction{tindex, tsourcepos} =
where
-- the numeric index of this txn's file within all the journal files,
-- or 0 if this txn has no known file (eg a forecasted txn)
tfileindex = maybe 0 (+1) $ elemIndex (sourceFilePath tsourcepos) (journalFilePaths j)
tfileindex = maybe 0 (+1) $ elemIndex (sourceName $ fst tsourcepos) (journalFilePaths j)
removeDates :: Text -> [Text]
removeDates =

2
hledger/Hledger/Cli/Commands/Check/Ordereddates.hs
View File

@ -30,7 +30,7 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
let
datestr = if date2_ ropts then "2" else ""
uniquestr = if checkunique then " and/or not unique" else ""
positionstr = showGenericSourcePos $ tsourcepos error
positionstr = showSourcePosPair $ tsourcepos error
txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous
txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error
Left $

2
hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs
View File

@ -49,5 +49,5 @@ checkposting leafandfullnames Posting{paccount,ptransaction} =
Nothing -> ""
Just t -> printf "\nseen in \"%s\" in transaction at: %s\n\n%s"
paccount
(showGenericSourcePos $ tsourcepos t)
(showSourcePosPair $ tsourcepos t)
(linesPrepend "> " . (<>"\n") . textChomp $ showTransaction t) :: String)

19
hledger/Hledger/Cli/Commands/Rewrite.hs
View File

@ -68,7 +68,7 @@ diffOutput j j' = do
let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t']
T.putStr $ renderPatch $ map (uncurry $ diffTxn j) changed
type Chunk = (GenericSourcePos, [DiffLine Text])
type Chunk = (SourcePos, [DiffLine Text])
-- XXX doctests, update needed:
-- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.First "x", D.Second "y"])]
@ -99,11 +99,11 @@ type Chunk = (GenericSourcePos, [DiffLine Text])
renderPatch :: [Chunk] -> Text
renderPatch = go Nothing . sortOn fst where
go _ [] = ""
go Nothing cs@((sourceFilePath -> fp, _):_) = fileHeader fp <> go (Just (fp, 0)) cs
go (Just (fp, _)) cs@((sourceFilePath -> fp', _):_) | fp /= fp' = go Nothing cs
go (Just (fp, offs)) ((sourceFirstLine -> lineno, diffs):cs) = chunkHeader <> chunk <> go (Just (fp, offs + adds - dels)) cs
go Nothing cs@((SourcePos fp _ _, _):_) = fileHeader fp <> go (Just (fp, 0)) cs
go (Just (fp, _)) cs@((SourcePos fp' _ _, _):_) | fp /= fp' = go Nothing cs
go (Just (fp, offs)) ((SourcePos _ lineno _, diffs):cs) = chunkHeader <> chunk <> go (Just (fp, offs + adds - dels)) cs
where
chunkHeader = T.pack $ printf "@@ -%d,%d +%d,%d @@\n" lineno dels (lineno+offs) adds
chunkHeader = T.pack $ printf "@@ -%d,%d +%d,%d @@\n" (unPos lineno) dels (unPos lineno+offs) adds
(dels, adds) = foldl' countDiff (0, 0) diffs
chunk = foldMap renderLine diffs
fileHeader fp = "--- " <> T.pack fp <> "\n+++ " <> T.pack fp <> "\n"
@ -119,20 +119,19 @@ renderPatch = go Nothing . sortOn fst where
Ctx s -> " " <> s <> "\n"
diffTxn :: Journal -> Transaction -> Transaction -> Chunk
diffTxn j t t' =
case tsourcepos t of
GenericSourcePos fp lineno _ -> (GenericSourcePos fp (lineno+1) 1, diffs) where
diffTxn j t t' = case tsourcepos t of
(pos1@(SourcePos fp line col), pos2) | pos1 == pos2 -> (SourcePos fp (line <> mkPos 1) col, diffs) where
-- TODO: use range and produce two chunks: one removes part of
-- original file, other adds transaction to new file with
-- suffix .ledger (generated). I.e. move transaction from one file to another.
diffs :: [DiffLine Text]
diffs = concatMap (traverse showPostingLines . mapDiff) $ D.getDiff (tpostings t) (tpostings t')
pos@(JournalSourcePos fp (line, line')) -> (pos, diffs) where
(pos1@(SourcePos fp line _), SourcePos _ line' _) -> (pos1, diffs) where
-- We do diff for original lines vs generated ones. Often leads
-- to big diff because of re-format effect.
diffs :: [DiffLine Text]
diffs = map mapDiff $ D.getDiff source changed'
source | Just contents <- lookup fp $ jfiles j = drop (line-1) . take line' $ T.lines contents
source | Just contents <- lookup fp $ jfiles j = drop (unPos line-1) . take (unPos line' - 1) $ T.lines contents
| otherwise = []
changed = T.lines $ showTransaction t'
changed' | null changed = changed