From 4cfd3cb590cb18adad9353ec40bcee7a0c730247 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Wed, 25 Aug 2021 13:04:28 +1000 Subject: [PATCH] lib!: Remove GenericSourcePos, and replace it with either SourcePos or (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. --- hledger-lib/Hledger/Data/Balancing.hs | 4 +- hledger-lib/Hledger/Data/Json.hs | 14 +++++- hledger-lib/Hledger/Data/Posting.hs | 6 +-- hledger-lib/Hledger/Data/Timeclock.hs | 9 ++-- hledger-lib/Hledger/Data/Transaction.hs | 26 +--------- hledger-lib/Hledger/Data/Types.hs | 21 ++++----- hledger-lib/Hledger/Read/Common.hs | 20 ++------ hledger-lib/Hledger/Read/CsvReader.hs | 12 ++--- hledger-lib/Hledger/Read/JournalReader.hs | 5 +- hledger-lib/Hledger/Read/TimeclockReader.hs | 2 +- hledger-lib/Hledger/Read/TimedotReader.hs | 4 +- hledger-lib/Hledger/Utils/Parse.hs | 20 ++++++++ hledger-ui/Hledger/UI/RegisterScreen.hs | 4 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 3 +- hledger-web/Hledger/Web/Widget/Common.hs | 2 +- .../Cli/Commands/Check/Ordereddates.hs | 2 +- .../Cli/Commands/Check/Uniqueleafnames.hs | 2 +- hledger/Hledger/Cli/Commands/Rewrite.hs | 47 +++++++++---------- 18 files changed, 92 insertions(+), 111 deletions(-) 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)