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 Test.HUnit | ||||||
| import Text.Printf | import Text.Printf | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
| import Text.Parsec.Pos |  | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| @ -56,8 +55,8 @@ instance Show ModifierTransaction where | |||||||
| instance Show PeriodicTransaction where | instance Show PeriodicTransaction where | ||||||
|     show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t)) |     show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t)) | ||||||
| 
 | 
 | ||||||
| nullsourcepos :: SourcePos | nullsourcepos :: GenericSourcePos | ||||||
| nullsourcepos = initialPos "" | nullsourcepos = GenericSourcePos "" 1 1 | ||||||
| 
 | 
 | ||||||
| nulltransaction :: Transaction | nulltransaction :: Transaction | ||||||
| nulltransaction = Transaction { | nulltransaction = Transaction { | ||||||
|  | |||||||
| @ -143,8 +143,13 @@ data Posting = Posting { | |||||||
| instance Eq Posting where | 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 |     (==) (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 { | data Transaction = Transaction { | ||||||
|       tsourcepos :: SourcePos, |       tsourcepos :: GenericSourcePos, | ||||||
|       tdate :: Day, |       tdate :: Day, | ||||||
|       tdate2 :: Maybe Day, |       tdate2 :: Maybe Day, | ||||||
|       tstatus :: ClearedStatus, |       tstatus :: ClearedStatus, | ||||||
| @ -169,7 +174,7 @@ data PeriodicTransaction = PeriodicTransaction { | |||||||
| data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data) | data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data) | ||||||
| 
 | 
 | ||||||
| data TimeLogEntry = TimeLogEntry { | data TimeLogEntry = TimeLogEntry { | ||||||
|       tlsourcepos :: SourcePos, |       tlsourcepos :: GenericSourcePos, | ||||||
|       tlcode :: TimeLogCode, |       tlcode :: TimeLogCode, | ||||||
|       tldatetime :: LocalTime, |       tldatetime :: LocalTime, | ||||||
|       tlaccount :: String, |       tlaccount :: String, | ||||||
|  | |||||||
| @ -51,7 +51,7 @@ import Text.Printf (hPrintf,printf) | |||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Utils.UTF8IOCompat (getContents) | import Hledger.Utils.UTF8IOCompat (getContents) | ||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| import Hledger.Read.JournalReader (amountp, statusp) | import Hledger.Read.JournalReader (amountp, statusp, genericSourcePos) | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| reader :: Reader | reader :: Reader | ||||||
| @ -643,7 +643,7 @@ transactionFromCsvRecord sourcepos rules record = t | |||||||
| 
 | 
 | ||||||
|     -- build the transaction |     -- build the transaction | ||||||
|     t = nulltransaction{ |     t = nulltransaction{ | ||||||
|       tsourcepos               = sourcepos, |       tsourcepos               = genericSourcePos sourcepos, | ||||||
|       tdate                    = date', |       tdate                    = date', | ||||||
|       tdate2                   = mdate2', |       tdate2                   = mdate2', | ||||||
|       tstatus                  = status, |       tstatus                  = status, | ||||||
|  | |||||||
| @ -22,6 +22,7 @@ module Hledger.Read.JournalReader ( | |||||||
|   reader, |   reader, | ||||||
|   -- * Parsers used elsewhere |   -- * Parsers used elsewhere | ||||||
|   parseJournalWith, |   parseJournalWith, | ||||||
|  |   genericSourcePos, | ||||||
|   getParentAccount, |   getParentAccount, | ||||||
|   journal, |   journal, | ||||||
|   directive, |   directive, | ||||||
| @ -97,6 +98,9 @@ parse _ = parseJournalWith journal | |||||||
| 
 | 
 | ||||||
| -- parsing utils | -- 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. | -- | Flatten a list of JournalUpdate's into a single equivalent one. | ||||||
| combineJournalUpdates :: [JournalUpdate] -> JournalUpdate | combineJournalUpdates :: [JournalUpdate] -> JournalUpdate | ||||||
| combineJournalUpdates us = liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence us | 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 :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction | ||||||
| transaction = do | transaction = do | ||||||
|   -- ptrace "transaction" |   -- ptrace "transaction" | ||||||
|   sourcepos <- getPosition |   sourcepos <- genericSourcePos <$> getPosition | ||||||
|   date <- datep <?> "transaction" |   date <- datep <?> "transaction" | ||||||
|   edate <- optionMaybe (secondarydatep date) <?> "secondary date" |   edate <- optionMaybe (secondarydatep date) <?> "secondary date" | ||||||
|   lookAhead (spacenonewline <|> newline) <?> "whitespace or newline" |   lookAhead (spacenonewline <|> newline) <?> "whitespace or newline" | ||||||
| @ -481,7 +485,7 @@ datep :: Stream [Char] m t => ParsecT [Char] JournalContext m Day | |||||||
| datep = do | datep = do | ||||||
|   -- hacky: try to ensure precise errors for invalid dates |   -- hacky: try to ensure precise errors for invalid dates | ||||||
|   -- XXX reported error position is not too good |   -- XXX reported error position is not too good | ||||||
|   -- pos <- getPosition |   -- pos <- genericSourcePos <$> getPosition | ||||||
|   datestr <- many1 $ choice' [digit, datesepchar] |   datestr <- many1 $ choice' [digit, datesepchar] | ||||||
|   let sepchars = nub $ sort $ filter (`elem` datesepchars) datestr |   let sepchars = nub $ sort $ filter (`elem` datesepchars) datestr | ||||||
|   when (length sepchars /= 1) $ fail $ "bad date, different separators used: " ++ datestr |   when (length sepchars /= 1) $ fail $ "bad date, different separators used: " ++ datestr | ||||||
|  | |||||||
| @ -61,7 +61,7 @@ import Hledger.Data | |||||||
| -- XXX too much reuse ? | -- XXX too much reuse ? | ||||||
| import Hledger.Read.JournalReader ( | import Hledger.Read.JournalReader ( | ||||||
|   directive, historicalpricedirective, defaultyeardirective, emptyorcommentlinep, datetimep, |   directive, historicalpricedirective, defaultyeardirective, emptyorcommentlinep, datetimep, | ||||||
|   parseJournalWith, modifiedaccountname |   parseJournalWith, modifiedaccountname, genericSourcePos | ||||||
|   ) |   ) | ||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| 
 | 
 | ||||||
| @ -103,7 +103,7 @@ timelogFile = do items <- many timelogItem | |||||||
| -- | Parse a timelog entry. | -- | Parse a timelog entry. | ||||||
| timelogentry :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry | timelogentry :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry | ||||||
| timelogentry = do | timelogentry = do | ||||||
|   sourcepos <- getPosition |   sourcepos <- genericSourcePos <$> getPosition | ||||||
|   code <- oneOf "bhioO" |   code <- oneOf "bhioO" | ||||||
|   many1 spacenonewline |   many1 spacenonewline | ||||||
|   datetime <- datetimep |   datetime <- datetimep | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user