abstract parsec's SourcePos so as to derive NFData
The NFData instance helps us time things with criterion.
This commit is contained in:
		
							parent
							
								
									2c16dded6e
								
							
						
					
					
						commit
						42d452f99c
					
				| @ -40,7 +40,6 @@ import Data.Time.Calendar | ||||
| import Test.HUnit | ||||
| import Text.Printf | ||||
| import qualified Data.Map as Map | ||||
| import Text.Parsec.Pos | ||||
| 
 | ||||
| import Hledger.Utils | ||||
| import Hledger.Data.Types | ||||
| @ -56,8 +55,8 @@ instance Show ModifierTransaction where | ||||
| instance Show PeriodicTransaction where | ||||
|     show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t)) | ||||
| 
 | ||||
| nullsourcepos :: SourcePos | ||||
| nullsourcepos = initialPos "" | ||||
| nullsourcepos :: GenericSourcePos | ||||
| nullsourcepos = GenericSourcePos "" 1 1 | ||||
| 
 | ||||
| nulltransaction :: Transaction | ||||
| nulltransaction = Transaction { | ||||
|  | ||||
| @ -143,8 +143,13 @@ data Posting = Posting { | ||||
| instance Eq Posting where | ||||
|     (==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 i1 _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 i2 _) =  a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 && i1==i2 | ||||
| 
 | ||||
| -- | The position of parse errors (eg), like parsec's SourcePos but generic. | ||||
| -- File name, 1-based line number and 1-based column number. | ||||
| data GenericSourcePos = GenericSourcePos FilePath Int Int | ||||
|   deriving (Eq, Read, Show, Ord, Data, Typeable) | ||||
| 
 | ||||
| data Transaction = Transaction { | ||||
|       tsourcepos :: SourcePos, | ||||
|       tsourcepos :: GenericSourcePos, | ||||
|       tdate :: Day, | ||||
|       tdate2 :: Maybe Day, | ||||
|       tstatus :: ClearedStatus, | ||||
| @ -169,7 +174,7 @@ data PeriodicTransaction = PeriodicTransaction { | ||||
| data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data) | ||||
| 
 | ||||
| data TimeLogEntry = TimeLogEntry { | ||||
|       tlsourcepos :: SourcePos, | ||||
|       tlsourcepos :: GenericSourcePos, | ||||
|       tlcode :: TimeLogCode, | ||||
|       tldatetime :: LocalTime, | ||||
|       tlaccount :: String, | ||||
|  | ||||
| @ -51,7 +51,7 @@ import Text.Printf (hPrintf,printf) | ||||
| import Hledger.Data | ||||
| import Hledger.Utils.UTF8IOCompat (getContents) | ||||
| import Hledger.Utils | ||||
| import Hledger.Read.JournalReader (amountp, statusp) | ||||
| import Hledger.Read.JournalReader (amountp, statusp, genericSourcePos) | ||||
| 
 | ||||
| 
 | ||||
| reader :: Reader | ||||
| @ -643,7 +643,7 @@ transactionFromCsvRecord sourcepos rules record = t | ||||
| 
 | ||||
|     -- build the transaction | ||||
|     t = nulltransaction{ | ||||
|       tsourcepos               = sourcepos, | ||||
|       tsourcepos               = genericSourcePos sourcepos, | ||||
|       tdate                    = date', | ||||
|       tdate2                   = mdate2', | ||||
|       tstatus                  = status, | ||||
|  | ||||
| @ -22,6 +22,7 @@ module Hledger.Read.JournalReader ( | ||||
|   reader, | ||||
|   -- * Parsers used elsewhere | ||||
|   parseJournalWith, | ||||
|   genericSourcePos, | ||||
|   getParentAccount, | ||||
|   journal, | ||||
|   directive, | ||||
| @ -97,6 +98,9 @@ parse _ = parseJournalWith journal | ||||
| 
 | ||||
| -- parsing utils | ||||
| 
 | ||||
| genericSourcePos :: SourcePos -> GenericSourcePos | ||||
| genericSourcePos p = GenericSourcePos (sourceName p) (sourceLine p) (sourceColumn p) | ||||
| 
 | ||||
| -- | Flatten a list of JournalUpdate's into a single equivalent one. | ||||
| combineJournalUpdates :: [JournalUpdate] -> JournalUpdate | ||||
| combineJournalUpdates us = liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence us | ||||
| @ -366,7 +370,7 @@ periodictransaction = do | ||||
| transaction :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction | ||||
| transaction = do | ||||
|   -- ptrace "transaction" | ||||
|   sourcepos <- getPosition | ||||
|   sourcepos <- genericSourcePos <$> getPosition | ||||
|   date <- datep <?> "transaction" | ||||
|   edate <- optionMaybe (secondarydatep date) <?> "secondary date" | ||||
|   lookAhead (spacenonewline <|> newline) <?> "whitespace or newline" | ||||
| @ -481,7 +485,7 @@ datep :: Stream [Char] m t => ParsecT [Char] JournalContext m Day | ||||
| datep = do | ||||
|   -- hacky: try to ensure precise errors for invalid dates | ||||
|   -- XXX reported error position is not too good | ||||
|   -- pos <- getPosition | ||||
|   -- pos <- genericSourcePos <$> getPosition | ||||
|   datestr <- many1 $ choice' [digit, datesepchar] | ||||
|   let sepchars = nub $ sort $ filter (`elem` datesepchars) datestr | ||||
|   when (length sepchars /= 1) $ fail $ "bad date, different separators used: " ++ datestr | ||||
|  | ||||
| @ -61,7 +61,7 @@ import Hledger.Data | ||||
| -- XXX too much reuse ? | ||||
| import Hledger.Read.JournalReader ( | ||||
|   directive, historicalpricedirective, defaultyeardirective, emptyorcommentlinep, datetimep, | ||||
|   parseJournalWith, modifiedaccountname | ||||
|   parseJournalWith, modifiedaccountname, genericSourcePos | ||||
|   ) | ||||
| import Hledger.Utils | ||||
| 
 | ||||
| @ -103,7 +103,7 @@ timelogFile = do items <- many timelogItem | ||||
| -- | Parse a timelog entry. | ||||
| timelogentry :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry | ||||
| timelogentry = do | ||||
|   sourcepos <- getPosition | ||||
|   sourcepos <- genericSourcePos <$> getPosition | ||||
|   code <- oneOf "bhioO" | ||||
|   many1 spacenonewline | ||||
|   datetime <- datetimep | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user