abstract parsec's SourcePos so as to derive NFData

The NFData instance helps us time things with criterion.
This commit is contained in:
Simon Michael 2015-06-28 16:20:28 -07:00
parent 2c16dded6e
commit 42d452f99c
5 changed files with 19 additions and 11 deletions

View File

@ -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 {

View File

@ -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,

View File

@ -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,

View File

@ -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

View File

@ -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