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.
This commit is contained in:
		
							parent
							
								
									04b17e00c4
								
							
						
					
					
						commit
						4cfd3cb590
					
				| @ -169,7 +169,7 @@ transactionBalanceError t errs = | |||||||
| 
 | 
 | ||||||
| annotateErrorWithTransaction :: Transaction -> String -> String | annotateErrorWithTransaction :: Transaction -> String -> String | ||||||
| annotateErrorWithTransaction t s = | annotateErrorWithTransaction t s = | ||||||
|   unlines [ showGenericSourcePos $ tsourcepos t, s |   unlines [ showSourcePosPair $ tsourcepos t, s | ||||||
|           , T.unpack . T.stripEnd $ showTransaction t |           , T.unpack . T.stripEnd $ showTransaction t | ||||||
|           ] |           ] | ||||||
| 
 | 
 | ||||||
| @ -586,7 +586,7 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt | |||||||
|       (case ptransaction p of |       (case ptransaction p of | ||||||
|          Nothing -> "?" -- shouldn't happen |          Nothing -> "?" -- shouldn't happen | ||||||
|          Just t ->  printf "%s\ntransaction:\n%s" |          Just t ->  printf "%s\ntransaction:\n%s" | ||||||
|                       (showGenericSourcePos pos) |                       (showSourcePos pos) | ||||||
|                       (textChomp $ showTransaction t) |                       (textChomp $ showTransaction t) | ||||||
|                       :: String |                       :: String | ||||||
|                       where |                       where | ||||||
|  | |||||||
| @ -24,6 +24,7 @@ import           Data.Decimal (DecimalRaw(..), roundTo) | |||||||
| import           Data.Maybe (fromMaybe) | import           Data.Maybe (fromMaybe) | ||||||
| import qualified Data.Text.Lazy    as TL | import qualified Data.Text.Lazy    as TL | ||||||
| import qualified Data.Text.Lazy.Builder as TB | import qualified Data.Text.Lazy.Builder as TB | ||||||
|  | import           Text.Megaparsec (Pos, SourcePos, mkPos, unPos) | ||||||
| 
 | 
 | ||||||
| import           Hledger.Data.Types | import           Hledger.Data.Types | ||||||
| import           Hledger.Data.Amount (amountsRaw, mixed) | import           Hledger.Data.Amount (amountsRaw, mixed) | ||||||
| @ -31,7 +32,12 @@ import           Hledger.Data.Amount (amountsRaw, mixed) | |||||||
| -- To JSON | -- To JSON | ||||||
| 
 | 
 | ||||||
| instance ToJSON Status | 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 | -- https://github.com/simonmichael/hledger/issues/1195 | ||||||
| 
 | 
 | ||||||
| @ -159,7 +165,11 @@ instance ToJSON Ledger | |||||||
| -- From JSON | -- From JSON | ||||||
| 
 | 
 | ||||||
| instance FromJSON Status | 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 Amount | ||||||
| instance FromJSON AmountStyle | instance FromJSON AmountStyle | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -125,15 +125,15 @@ post' acc amt ass = posting {paccount=acc, pamount=mixedAmount amt, pbalanceasse | |||||||
| vpost' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting | vpost' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting | ||||||
| vpost' acc amt ass = (post' acc amt ass){ptype=VirtualPosting, pbalanceassertion=ass} | vpost' acc amt ass = (post' acc amt ass){ptype=VirtualPosting, pbalanceassertion=ass} | ||||||
| 
 | 
 | ||||||
| nullsourcepos :: GenericSourcePos | nullsourcepos :: (SourcePos, SourcePos) | ||||||
| nullsourcepos = JournalSourcePos "" (1,1) | nullsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1)) | ||||||
| 
 | 
 | ||||||
| nullassertion :: BalanceAssertion | nullassertion :: BalanceAssertion | ||||||
| nullassertion = BalanceAssertion | nullassertion = BalanceAssertion | ||||||
|                   {baamount=nullamt |                   {baamount=nullamt | ||||||
|                   ,batotal=False |                   ,batotal=False | ||||||
|                   ,bainclusive=False |                   ,bainclusive=False | ||||||
|                   ,baposition=nullsourcepos |                   ,baposition=initialPos "" | ||||||
|                   } |                   } | ||||||
| 
 | 
 | ||||||
| -- | Make a partial, exclusive balance assertion. | -- | Make a partial, exclusive balance assertion. | ||||||
|  | |||||||
| @ -77,10 +77,7 @@ timeclockEntriesToTransactions now (i:o:rest) | |||||||
| {- HLINT ignore timeclockEntriesToTransactions -} | {- HLINT ignore timeclockEntriesToTransactions -} | ||||||
| 
 | 
 | ||||||
| errorExpectedCodeButGot expected actual = errorWithSourceLine line $ "expected timeclock code " ++ (show expected) ++ " but got " ++ show (tlcode actual) | errorExpectedCodeButGot expected actual = errorWithSourceLine line $ "expected timeclock code " ++ (show expected) ++ " but got " ++ show (tlcode actual) | ||||||
|     where |     where line = unPos . sourceLine $ tlsourcepos actual | ||||||
|         line = case tlsourcepos actual of |  | ||||||
|                   GenericSourcePos _ l _ -> l |  | ||||||
|                   JournalSourcePos _ (l, _) -> l |  | ||||||
| 
 | 
 | ||||||
| errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg | errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg | ||||||
| 
 | 
 | ||||||
| @ -95,7 +92,7 @@ entryFromTimeclockInOut i o | |||||||
|     where |     where | ||||||
|       t = Transaction { |       t = Transaction { | ||||||
|             tindex       = 0, |             tindex       = 0, | ||||||
|             tsourcepos   = tlsourcepos i, |             tsourcepos   = (tlsourcepos i, tlsourcepos i), | ||||||
|             tdate        = idate, |             tdate        = idate, | ||||||
|             tdate2       = Nothing, |             tdate2       = Nothing, | ||||||
|             tstatus      = Cleared, |             tstatus      = Cleared, | ||||||
| @ -135,7 +132,7 @@ tests_Timeclock = testGroup "Timeclock" [ | |||||||
|       let now = utcToLocalTime tz now' |       let now = utcToLocalTime tz now' | ||||||
|           nowstr = showtime now |           nowstr = showtime now | ||||||
|           yesterday = prevday today |           yesterday = prevday today | ||||||
|           clockin = TimeclockEntry nullsourcepos In |           clockin = TimeclockEntry (initialPos "") In | ||||||
|           mktime d = LocalTime d . fromMaybe midnight . |           mktime d = LocalTime d . fromMaybe midnight . | ||||||
|                      parseTimeM True defaultTimeLocale "%H:%M:%S" |                      parseTimeM True defaultTimeLocale "%H:%M:%S" | ||||||
|           showtime = formatTime defaultTimeLocale "%H:%M" |           showtime = formatTime defaultTimeLocale "%H:%M" | ||||||
|  | |||||||
| @ -7,7 +7,6 @@ tags. | |||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| 
 | 
 | ||||||
| {-# LANGUAGE LambdaCase        #-} |  | ||||||
| {-# LANGUAGE NamedFieldPuns    #-} | {-# LANGUAGE NamedFieldPuns    #-} | ||||||
| {-# LANGUAGE OverloadedStrings #-} | {-# LANGUAGE OverloadedStrings #-} | ||||||
| {-# LANGUAGE RecordWildCards   #-} | {-# LANGUAGE RecordWildCards   #-} | ||||||
| @ -44,10 +43,6 @@ module Hledger.Data.Transaction | |||||||
| , showTransactionOneLineAmounts | , showTransactionOneLineAmounts | ||||||
|   -- showPostingLine |   -- showPostingLine | ||||||
| , showPostingLines | , showPostingLines | ||||||
|   -- * GenericSourcePos |  | ||||||
| , sourceFilePath |  | ||||||
| , sourceFirstLine |  | ||||||
| , showGenericSourcePos |  | ||||||
| , transactionFile | , transactionFile | ||||||
|   -- * tests |   -- * tests | ||||||
| , tests_Transaction | , tests_Transaction | ||||||
| @ -71,22 +66,6 @@ import Hledger.Data.Amount | |||||||
| import Hledger.Data.Valuation | import Hledger.Data.Valuation | ||||||
| import Text.Tabular.AsciiWide | 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 | ||||||
| nulltransaction = Transaction { | nulltransaction = Transaction { | ||||||
| @ -393,10 +372,7 @@ transactionMapPostingAmounts f  = transactionMapPostings (postingTransformAmount | |||||||
| 
 | 
 | ||||||
| -- | The file path from which this transaction was parsed. | -- | The file path from which this transaction was parsed. | ||||||
| transactionFile :: Transaction -> FilePath | transactionFile :: Transaction -> FilePath | ||||||
| transactionFile Transaction{tsourcepos} = | transactionFile Transaction{tsourcepos} = sourceName $ fst tsourcepos | ||||||
|   case tsourcepos of |  | ||||||
|     GenericSourcePos f _ _ -> f |  | ||||||
|     JournalSourcePos f _   -> f |  | ||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -31,7 +31,6 @@ import Data.Decimal (Decimal, DecimalRaw(..)) | |||||||
| import Data.Default (Default(..)) | import Data.Default (Default(..)) | ||||||
| import Data.Functor (($>)) | import Data.Functor (($>)) | ||||||
| import Data.List (intercalate) | import Data.List (intercalate) | ||||||
| import Text.Blaze (ToMarkup(..)) |  | ||||||
| --XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html | --XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html | ||||||
| --Note: You should use Data.Map.Strict instead of this module if: | --Note: You should use Data.Map.Strict instead of this module if: | ||||||
| --You will eventually need all the values stored. | --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.Clock.POSIX (POSIXTime) | ||||||
| import Data.Time.LocalTime (LocalTime) | import Data.Time.LocalTime (LocalTime) | ||||||
| import Data.Word (Word8) | import Data.Word (Word8) | ||||||
|  | import Text.Blaze (ToMarkup(..)) | ||||||
|  | import Text.Megaparsec (SourcePos) | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils.Regex | 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. | --    at once. Not implemented, requires #934. | ||||||
| -- | -- | ||||||
| data BalanceAssertion = BalanceAssertion { | data BalanceAssertion = BalanceAssertion { | ||||||
|       baamount    :: Amount,             -- ^ the expected balance in a particular commodity |       baamount    :: Amount,    -- ^ the expected balance in a particular commodity | ||||||
|       batotal     :: Bool,               -- ^ disallow additional non-asserted commodities ? |       batotal     :: Bool,      -- ^ disallow additional non-asserted commodities ? | ||||||
|       bainclusive :: Bool,               -- ^ include subaccounts when calculating the actual balance ? |       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) |     } deriving (Eq,Generic,Show) | ||||||
| 
 | 
 | ||||||
| data Posting = Posting { | data Posting = Posting { | ||||||
| @ -385,16 +386,10 @@ instance Show Posting where | |||||||
|     ,"poriginal="         ++ show poriginal |     ,"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 { | data Transaction = Transaction { | ||||||
|       tindex                   :: Integer,   -- ^ this transaction's 1-based position in the transaction stream, or 0 when not available |       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 |       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, |       tdate                    :: Day, | ||||||
|       tdate2                   :: Maybe Day, |       tdate2                   :: Maybe Day, | ||||||
|       tstatus                  :: Status, |       tstatus                  :: Status, | ||||||
| @ -458,7 +453,7 @@ nullperiodictransaction = PeriodicTransaction{ | |||||||
| data TimeclockCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Generic) | data TimeclockCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Generic) | ||||||
| 
 | 
 | ||||||
| data TimeclockEntry = TimeclockEntry { | data TimeclockEntry = TimeclockEntry { | ||||||
|       tlsourcepos   :: GenericSourcePos, |       tlsourcepos   :: SourcePos, | ||||||
|       tlcode        :: TimeclockCode, |       tlcode        :: TimeclockCode, | ||||||
|       tldatetime    :: LocalTime, |       tldatetime    :: LocalTime, | ||||||
|       tlaccount     :: AccountName, |       tlaccount     :: AccountName, | ||||||
|  | |||||||
| @ -35,8 +35,6 @@ module Hledger.Read.Common ( | |||||||
|   rawOptsToInputOpts, |   rawOptsToInputOpts, | ||||||
| 
 | 
 | ||||||
|   -- * parsing utilities |   -- * parsing utilities | ||||||
|   genericSourcePos, |  | ||||||
|   journalSourcePos, |  | ||||||
|   parseAndFinaliseJournal, |   parseAndFinaliseJournal, | ||||||
|   parseAndFinaliseJournal', |   parseAndFinaliseJournal', | ||||||
|   journalFinalise, |   journalFinalise, | ||||||
| @ -252,16 +250,6 @@ commodityStyleFromRawOpts rawOpts = | |||||||
|     parseCommodity optStr = case amountp'' optStr of |     parseCommodity optStr = case amountp'' optStr of | ||||||
|         Left _ -> Left optStr |         Left _ -> Left optStr | ||||||
|         Right (Amount acommodity _ astyle _) -> Right (acommodity, astyle) |         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 | -- | Given a parser to ParsedJournal, input options, file path and | ||||||
| -- content: run the parser on the content, and finalise the result to | -- content: run the parser on the content, and finalise the result to | ||||||
| -- get a Journal; or throw an error. | -- get a Journal; or throw an error. | ||||||
| @ -376,7 +364,7 @@ journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j | |||||||
|       | otherwise = Left $ |       | otherwise = Left $ | ||||||
|           printf "undeclared payee \"%s\"\nat: %s\n\n%s" |           printf "undeclared payee \"%s\"\nat: %s\n\n%s" | ||||||
|             (T.unpack p) |             (T.unpack p) | ||||||
|             (showGenericSourcePos $ tsourcepos t) |             (showSourcePosPair $ tsourcepos t) | ||||||
|             (linesPrepend2 "> " "  " . (<>"\n") . textChomp $ showTransaction t) |             (linesPrepend2 "> " "  " . (<>"\n") . textChomp $ showTransaction t) | ||||||
|       where |       where | ||||||
|         p  = transactionPayee t |         p  = transactionPayee t | ||||||
| @ -394,7 +382,7 @@ journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j | |||||||
|           ++ case ptransaction of |           ++ case ptransaction of | ||||||
|               Nothing -> "" |               Nothing -> "" | ||||||
|               Just t  -> printf "in transaction at: %s\n\n%s" |               Just t  -> printf "in transaction at: %s\n\n%s" | ||||||
|                           (showGenericSourcePos $ tsourcepos t) |                           (showSourcePosPair $ tsourcepos t) | ||||||
|                           (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t) |                           (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t) | ||||||
|       where |       where | ||||||
|         as = journalAccountNamesDeclared j |         as = journalAccountNamesDeclared j | ||||||
| @ -413,7 +401,7 @@ journalCheckCommoditiesDeclared j = | |||||||
|           ++ case ptransaction of |           ++ case ptransaction of | ||||||
|               Nothing -> "" |               Nothing -> "" | ||||||
|               Just t  -> printf "in transaction at: %s\n\n%s" |               Just t  -> printf "in transaction at: %s\n\n%s" | ||||||
|                           (showGenericSourcePos $ tsourcepos t) |                           (showSourcePosPair $ tsourcepos t) | ||||||
|                           (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t) |                           (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t) | ||||||
|       where |       where | ||||||
|         mfirstundeclaredcomm = |         mfirstundeclaredcomm = | ||||||
| @ -908,7 +896,7 @@ priceamountp baseAmt = label "transaction price" $ do | |||||||
| 
 | 
 | ||||||
| balanceassertionp :: JournalParser m BalanceAssertion | balanceassertionp :: JournalParser m BalanceAssertion | ||||||
| balanceassertionp = do | balanceassertionp = do | ||||||
|   sourcepos <- genericSourcePos <$> lift getSourcePos |   sourcepos <- getSourcePos | ||||||
|   char '=' |   char '=' | ||||||
|   istotal <- fmap isJust $ optional $ try $ char '=' |   istotal <- fmap isJust $ optional $ try $ char '=' | ||||||
|   isinclusive <- fmap isJust $ optional $ try $ char '*' |   isinclusive <- fmap isJust $ optional $ try $ char '*' | ||||||
|  | |||||||
| @ -77,7 +77,7 @@ import Text.Printf (printf) | |||||||
| 
 | 
 | ||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Utils | 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 | --- ** doctest setup | ||||||
| -- $setup | -- $setup | ||||||
| @ -953,7 +953,7 @@ transactionFromCsvRecord sourcepos rules record = t | |||||||
|     -- 4. Build the transaction (and name it, so the postings can reference it). |     -- 4. Build the transaction (and name it, so the postings can reference it). | ||||||
| 
 | 
 | ||||||
|     t = nulltransaction{ |     t = nulltransaction{ | ||||||
|            tsourcepos        = genericSourcePos sourcepos  -- the CSV line number |            tsourcepos        = (sourcepos, sourcepos)  -- the CSV line number | ||||||
|           ,tdate             = date' |           ,tdate             = date' | ||||||
|           ,tdate2            = mdate2' |           ,tdate2            = mdate2' | ||||||
|           ,tstatus           = status |           ,tstatus           = status | ||||||
| @ -1028,7 +1028,7 @@ getAmount rules record currency p1IsVirtual n = | |||||||
| 
 | 
 | ||||||
| -- | Figure out the expected balance (assertion or assignment) specified for posting N, | -- | Figure out the expected balance (assertion or assignment) specified for posting N, | ||||||
| -- if any (and its parse position). | -- 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 | getBalance rules record currency n = do | ||||||
|   v <- (fieldval ("balance"<> T.pack (show n)) |   v <- (fieldval ("balance"<> T.pack (show n)) | ||||||
|         -- for posting 1, also recognise the old field name |         -- for posting 1, also recognise the old field name | ||||||
| @ -1037,7 +1037,7 @@ getBalance rules record currency n = do | |||||||
|     "" -> Nothing |     "" -> Nothing | ||||||
|     s  -> Just ( |     s  -> Just ( | ||||||
|             parseBalanceAmount rules record currency n s |             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 |            )               -- XXX the csv record's line number would be good | ||||||
|   where |   where | ||||||
|     fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text |     fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text | ||||||
| @ -1101,7 +1101,7 @@ parseDecimalMark rules = do | |||||||
| -- possibly set by a balance-type rule. | -- possibly set by a balance-type rule. | ||||||
| -- The CSV rules and current record are also provided, to be shown in case | -- The CSV rules and current record are also provided, to be shown in case | ||||||
| -- balance-type's argument is bad (XXX refactor). | -- 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} | mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos} | ||||||
|   where |   where | ||||||
|     assrt = |     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. | -- | Figure out the account name specified for posting N, if any. | ||||||
| -- And whether it is the default unknown account (which may be | -- And whether it is the default unknown account (which may be | ||||||
| -- improved later) or an explicitly set account (which may not). | -- 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 = | getAccount rules record mamount mbalance n = | ||||||
|   let |   let | ||||||
|     fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text |     fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text | ||||||
|  | |||||||
| @ -44,7 +44,6 @@ module Hledger.Read.JournalReader ( | |||||||
|   reader, |   reader, | ||||||
| 
 | 
 | ||||||
|   -- * Parsing utils |   -- * Parsing utils | ||||||
|   genericSourcePos, |  | ||||||
|   parseAndFinaliseJournal, |   parseAndFinaliseJournal, | ||||||
|   runJournalParser, |   runJournalParser, | ||||||
|   rjp, |   rjp, | ||||||
| @ -696,7 +695,7 @@ transactionp = do | |||||||
|   let year = first3 $ toGregorian date |   let year = first3 $ toGregorian date | ||||||
|   postings <- postingsp (Just year) |   postings <- postingsp (Just year) | ||||||
|   endpos <- getSourcePos |   endpos <- getSourcePos | ||||||
|   let sourcepos = journalSourcePos startpos endpos |   let sourcepos = (startpos, endpos) | ||||||
|   return $ txnTieKnot $ Transaction 0 "" sourcepos date edate status code description comment tags postings |   return $ txnTieKnot $ Transaction 0 "" sourcepos date edate status code description comment tags postings | ||||||
| 
 | 
 | ||||||
| --- *** postings | --- *** postings | ||||||
| @ -921,7 +920,7 @@ tests_JournalReader = testGroup "JournalReader" [ | |||||||
|         "    ; ptag2: val2" |         "    ; ptag2: val2" | ||||||
|         ]) |         ]) | ||||||
|       nulltransaction{ |       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="", |         tprecedingcomment="", | ||||||
|         tdate=fromGregorian 2012 5 14, |         tdate=fromGregorian 2012 5 14, | ||||||
|         tdate2=Just $ fromGregorian 2012 5 15, |         tdate2=Just $ fromGregorian 2012 5 15, | ||||||
|  | |||||||
| @ -119,7 +119,7 @@ timeclockfilep = do many timeclockitemp | |||||||
| -- | Parse a timeclock entry. | -- | Parse a timeclock entry. | ||||||
| timeclockentryp :: JournalParser m TimeclockEntry | timeclockentryp :: JournalParser m TimeclockEntry | ||||||
| timeclockentryp = do | timeclockentryp = do | ||||||
|   sourcepos <- genericSourcePos <$> lift getSourcePos |   sourcepos <- getSourcePos | ||||||
|   code <- oneOf ("bhioO" :: [Char]) |   code <- oneOf ("bhioO" :: [Char]) | ||||||
|   lift skipNonNewlineSpaces1 |   lift skipNonNewlineSpaces1 | ||||||
|   datetime <- datetimep |   datetime <- datetimep | ||||||
|  | |||||||
| @ -168,7 +168,7 @@ orgheadingprefixp = do | |||||||
| entryp :: JournalParser m Transaction | entryp :: JournalParser m Transaction | ||||||
| entryp = do | entryp = do | ||||||
|   lift $ traceparse "entryp" |   lift $ traceparse "entryp" | ||||||
|   pos <- genericSourcePos <$> getSourcePos |   pos <- getSourcePos | ||||||
|   notFollowedBy datelinep |   notFollowedBy datelinep | ||||||
|   lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1] |   lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1] | ||||||
|   a <- modifiedaccountnamep |   a <- modifiedaccountnamep | ||||||
| @ -178,7 +178,7 @@ entryp = do | |||||||
|     <|> (durationp <* |     <|> (durationp <* | ||||||
|          (try (lift followingcommentp) <|> (newline >> return ""))) |          (try (lift followingcommentp) <|> (newline >> return ""))) | ||||||
|   let t = nulltransaction{ |   let t = nulltransaction{ | ||||||
|         tsourcepos = pos, |         tsourcepos = (pos, pos), | ||||||
|         tstatus    = Cleared, |         tstatus    = Cleared, | ||||||
|         tpostings  = [ |         tpostings  = [ | ||||||
|           nullposting{paccount=a |           nullposting{paccount=a | ||||||
|  | |||||||
| @ -6,6 +6,15 @@ module Hledger.Utils.Parse ( | |||||||
|   SimpleTextParser, |   SimpleTextParser, | ||||||
|   TextParser, |   TextParser, | ||||||
| 
 | 
 | ||||||
|  |   SourcePos(..), | ||||||
|  |   mkPos, | ||||||
|  |   unPos, | ||||||
|  |   initialPos, | ||||||
|  | 
 | ||||||
|  |   -- * SourcePos | ||||||
|  |   showSourcePosPair, | ||||||
|  |   showSourcePos, | ||||||
|  | 
 | ||||||
|   choice', |   choice', | ||||||
|   choiceInState, |   choiceInState, | ||||||
|   surroundedBy, |   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. | -- | A parser of text that runs in some monad. | ||||||
| type TextParser m a = ParsecT CustomErr Text m a | 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. | -- | Backtracking choice, use this when alternatives share a prefix. | ||||||
| -- Consumes no input if all choices fail. | -- Consumes no input if all choices fail. | ||||||
| choice' :: [TextParser m a] -> TextParser m a | choice' :: [TextParser m a] -> TextParser m a | ||||||
|  | |||||||
| @ -326,9 +326,7 @@ rsHandle ui@UIState{ | |||||||
|             (pos,f) = case listSelectedElement rsList of |             (pos,f) = case listSelectedElement rsList of | ||||||
|                         Nothing -> (endPosition, journalFilePath j) |                         Nothing -> (endPosition, journalFilePath j) | ||||||
|                         Just (_, RegisterScreenItem{ |                         Just (_, RegisterScreenItem{ | ||||||
|                           rsItemTransaction=Transaction{tsourcepos=GenericSourcePos f l c}}) -> (Just (l, Just c),f) |                           rsItemTransaction=Transaction{tsourcepos=(SourcePos f l c,_)}}) -> (Just (unPos l, Just $ unPos c),f) | ||||||
|                         Just (_, RegisterScreenItem{ |  | ||||||
|                           rsItemTransaction=Transaction{tsourcepos=JournalSourcePos f (l,_)}}) -> (Just (l, Nothing),f) |  | ||||||
| 
 | 
 | ||||||
|         -- display mode/query toggles |         -- display mode/query toggles | ||||||
|         VtyEvent (EvKey (KChar 'B') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCost ui |         VtyEvent (EvKey (KChar 'B') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCost ui | ||||||
|  | |||||||
| @ -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 |         VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui | ||||||
|           where |           where | ||||||
|             (pos,f) = case tsourcepos t of |             (pos,f) = case tsourcepos t of | ||||||
|                         GenericSourcePos f l c    -> (Just (l, Just c),f) |                         (SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f) | ||||||
|                         JournalSourcePos f (l1,_) -> (Just (l1, Nothing),f) |  | ||||||
|         AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old -> |         AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old -> | ||||||
|           continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui |           continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui | ||||||
|           where |           where | ||||||
|  | |||||||
| @ -112,7 +112,7 @@ transactionFragment j Transaction{tindex, tsourcepos} = | |||||||
|   where |   where | ||||||
|     -- the numeric index of this txn's file within all the journal files, |     -- 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) |     -- 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 :: Text -> [Text] | ||||||
| removeDates = | removeDates = | ||||||
|  | |||||||
| @ -30,7 +30,7 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do | |||||||
|         let |         let | ||||||
|           datestr = if date2_ ropts then "2" else "" |           datestr = if date2_ ropts then "2" else "" | ||||||
|           uniquestr = if checkunique then " and/or not unique" 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 |           txn1str = T.unpack . linesPrepend  (T.pack "  ")               $ showTransaction previous | ||||||
|           txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack "  ") $ showTransaction error |           txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack "  ") $ showTransaction error | ||||||
|         Left $ |         Left $ | ||||||
|  | |||||||
| @ -49,5 +49,5 @@ checkposting leafandfullnames Posting{paccount,ptransaction} = | |||||||
|         Nothing -> "" |         Nothing -> "" | ||||||
|         Just t  -> printf "\nseen in \"%s\" in transaction at: %s\n\n%s" |         Just t  -> printf "\nseen in \"%s\" in transaction at: %s\n\n%s" | ||||||
|                     paccount |                     paccount | ||||||
|                     (showGenericSourcePos $ tsourcepos t) |                     (showSourcePosPair $ tsourcepos t) | ||||||
|                     (linesPrepend "> " . (<>"\n") . textChomp $ showTransaction t) :: String) |                     (linesPrepend "> " . (<>"\n") . textChomp $ showTransaction t) :: String) | ||||||
|  | |||||||
| @ -68,7 +68,7 @@ diffOutput j j' = do | |||||||
|     let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t'] |     let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t'] | ||||||
|     T.putStr $ renderPatch $ map (uncurry $ diffTxn j) changed |     T.putStr $ renderPatch $ map (uncurry $ diffTxn j) changed | ||||||
| 
 | 
 | ||||||
| type Chunk = (GenericSourcePos, [DiffLine Text]) | type Chunk = (SourcePos, [DiffLine Text]) | ||||||
| 
 | 
 | ||||||
| -- XXX doctests, update needed: | -- XXX doctests, update needed: | ||||||
| -- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.First "x", D.Second "y"])] | -- >>> 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 :: [Chunk] -> Text | ||||||
| renderPatch = go Nothing . sortOn fst where | renderPatch = go Nothing . sortOn fst where | ||||||
|     go _ [] = "" |     go _ [] = "" | ||||||
|     go Nothing cs@((sourceFilePath -> fp, _):_) = fileHeader fp <> go (Just (fp, 0)) cs |     go Nothing cs@((SourcePos fp _ _, _):_) = fileHeader fp <> go (Just (fp, 0)) cs | ||||||
|     go (Just (fp, _)) cs@((sourceFilePath -> fp', _):_) | fp /= fp' = go Nothing cs |     go (Just (fp, _)) cs@((SourcePos fp' _ _, _):_) | fp /= fp' = go Nothing cs | ||||||
|     go (Just (fp, offs)) ((sourceFirstLine -> lineno, diffs):cs) = chunkHeader <> chunk <> go (Just (fp, offs + adds - dels)) cs |     go (Just (fp, offs)) ((SourcePos _ lineno _, diffs):cs) = chunkHeader <> chunk <> go (Just (fp, offs + adds - dels)) cs | ||||||
|         where |         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 |             (dels, adds) = foldl' countDiff (0, 0) diffs | ||||||
|             chunk = foldMap renderLine diffs |             chunk = foldMap renderLine diffs | ||||||
|     fileHeader fp = "--- " <> T.pack fp <> "\n+++ " <> T.pack fp <> "\n" |     fileHeader fp = "--- " <> T.pack fp <> "\n+++ " <> T.pack fp <> "\n" | ||||||
| @ -119,25 +119,24 @@ renderPatch = go Nothing . sortOn fst where | |||||||
|         Ctx s -> " " <> s <> "\n" |         Ctx s -> " " <> s <> "\n" | ||||||
| 
 | 
 | ||||||
| diffTxn :: Journal -> Transaction -> Transaction -> Chunk | diffTxn :: Journal -> Transaction -> Transaction -> Chunk | ||||||
| diffTxn j t t' = | diffTxn j t t' = case tsourcepos t of | ||||||
|         case tsourcepos t of |     (pos1@(SourcePos fp line col), pos2) | pos1 == pos2 -> (SourcePos fp (line <> mkPos 1) col, diffs) where | ||||||
|             GenericSourcePos fp lineno _ -> (GenericSourcePos fp (lineno+1) 1, diffs) where |         -- TODO: use range and produce two chunks: one removes part of | ||||||
|                 -- TODO: use range and produce two chunks: one removes part of |         --       original file, other adds transaction to new file with | ||||||
|                 --       original file, other adds transaction to new file with |         --       suffix .ledger (generated). I.e. move transaction from one file to another. | ||||||
|                 --       suffix .ledger (generated). I.e. move transaction from one file to another. |         diffs :: [DiffLine Text] | ||||||
|                 diffs :: [DiffLine Text] |         diffs = concatMap (traverse showPostingLines . mapDiff) $ D.getDiff (tpostings t) (tpostings t') | ||||||
|                 diffs = concatMap (traverse showPostingLines . mapDiff) $ D.getDiff (tpostings t) (tpostings t') |     (pos1@(SourcePos fp line _), SourcePos _ line' _) -> (pos1, diffs) where | ||||||
|             pos@(JournalSourcePos fp (line, line')) -> (pos, diffs) where |         -- We do diff for original lines vs generated ones. Often leads | ||||||
|                 -- We do diff for original lines vs generated ones. Often leads |         -- to big diff because of re-format effect. | ||||||
|                 -- to big diff because of re-format effect. |         diffs :: [DiffLine Text] | ||||||
|                 diffs :: [DiffLine Text] |         diffs = map mapDiff $ D.getDiff source changed' | ||||||
|                 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 | ||||||
|                 source | Just contents <- lookup fp $ jfiles j = drop (line-1) . take line' $ T.lines contents |                | otherwise = [] | ||||||
|                        | otherwise = [] |         changed = T.lines $ showTransaction t' | ||||||
|                 changed = T.lines $ showTransaction t' |         changed' | null changed = changed | ||||||
|                 changed' | null changed = changed |                  | T.null $ last changed = init changed | ||||||
|                          | T.null $ last changed = init changed |                  | otherwise = changed | ||||||
|                          | otherwise = changed |  | ||||||
| 
 | 
 | ||||||
| data DiffLine a = Del a | Add a | Ctx a | data DiffLine a = Del a | Add a | Ctx a | ||||||
|     deriving (Show, Functor, Foldable, Traversable) |     deriving (Show, Functor, Foldable, Traversable) | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user