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