diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index ee0cc85e1..644fcc39e 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Json.hs b/hledger-lib/Hledger/Data/Json.hs index 237eb3218..7036bbd77 100644 --- a/hledger-lib/Hledger/Data/Json.hs +++ b/hledger-lib/Hledger/Data/Json.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 84f4263e3..e18d9e6e9 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -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. diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index 078c14b66..b0a9fb821 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -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" diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index ae5e4defa..5bfbcdf8e 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index c6ba820e4..a8a6e8528 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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 @@ -338,10 +339,10 @@ instance Show Status where -- custom show.. bad idea.. don't do it.. -- at once. Not implemented, requires #934. -- 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 + 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 :: 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, diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 2f90d6fc8..b1d69978e 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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 '*' diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 87efb5141..7ab72037c 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 28ad1d0f7..6e124b39b 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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, diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 6e1ca9d93..d4a50e01f 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 21ec6de49..af05e66d9 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index 9d4013d7d..230c5d957 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 37b2de3e7..65b505739 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 3370d19c9..aa4f28908 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Widget/Common.hs b/hledger-web/Hledger/Web/Widget/Common.hs index 9c1192cca..2ce97f20e 100644 --- a/hledger-web/Hledger/Web/Widget/Common.hs +++ b/hledger-web/Hledger/Web/Widget/Common.hs @@ -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 = diff --git a/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs b/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs index aeac6dd90..11e4677de 100755 --- a/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs +++ b/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs @@ -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 $ diff --git a/hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs b/hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs index 9de7e77db..523244717 100755 --- a/hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs +++ b/hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs @@ -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) diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index ef27cdf24..f9e574ce1 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -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,25 +119,24 @@ 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 - -- 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 - -- 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 - | otherwise = [] - changed = T.lines $ showTransaction t' - changed' | null changed = changed - | T.null $ last changed = init changed - | otherwise = changed +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') + (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 (unPos line-1) . take (unPos line' - 1) $ T.lines contents + | otherwise = [] + changed = T.lines $ showTransaction t' + changed' | null changed = changed + | T.null $ last changed = init changed + | otherwise = changed data DiffLine a = Del a | Add a | Ctx a deriving (Show, Functor, Foldable, Traversable)