slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: add some strictness annotations to the parser

Browse Source 
This was done to reverse minor performance regressions introduced in the
previous commits
This commit is contained in:
Alex Chen 2018-05-26 22:42:02 -06:00 committed by Simon Michael
parent d79e707485
commit c3f5659d75
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
hledger-lib/Hledger/Read/Common.hs
View File

@ -386,14 +386,14 @@ datep' mYear = do
case fromGregorianValid year month day of case fromGregorianValid year month day of
Nothing -> fail $ "well-formed but invalid date: " ++ dateStr Nothing -> fail $ "well-formed but invalid date: " ++ dateStr
Just date -> pure date Just date -> pure $! date
partialDate :: Maybe Year -> Integer -> Char -> Int -> TextParser m Day partialDate :: Maybe Year -> Integer -> Char -> Int -> TextParser m Day
partialDate mYear month sep day = case mYear of partialDate mYear month sep day = case mYear of
Just year -> Just year ->
case fromGregorianValid year (fromIntegral month) day of case fromGregorianValid year (fromIntegral month) day of
Nothing -> fail $ "well-formed but invalid date: " ++ dateStr Nothing -> fail $ "well-formed but invalid date: " ++ dateStr
Just date -> pure date Just date -> pure $! date
where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day
Nothing -> fail $ Nothing -> fail $
@ -446,7 +446,7 @@ modifiedaccountnamep = do
parent <- getParentAccount parent <- getParentAccount
aliases <- getAccountAliases aliases <- getAccountAliases
a <- lift accountnamep a <- lift accountnamep
return $ return $!
accountNameApplyAliases aliases $ accountNameApplyAliases aliases $
-- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference -- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference
joinAccountNames parent joinAccountNames parent
@ -461,7 +461,7 @@ accountnamep :: TextParser m AccountName
accountnamep = do accountnamep = do
firstPart <- part firstPart <- part
otherParts <- many $ try $ singleSpace *> part otherParts <- many $ try $ singleSpace *> part
pure $ T.unwords $ firstPart : otherParts pure $! T.unwords $ firstPart : otherParts
where where
part = takeWhile1P Nothing (not . isSpace) part = takeWhile1P Nothing (not . isSpace)
singleSpace = void spacenonewline *> notFollowedBy spacenonewline singleSpace = void spacenonewline *> notFollowedBy spacenonewline
@ -822,8 +822,8 @@ isDigitSeparatorChar c = isDecimalPointChar c || c == ' '
data DigitGrp = DigitGrp { data DigitGrp = DigitGrp {
digitGroupLength :: Int, digitGroupLength :: !Int,
digitGroupNumber :: Integer digitGroupNumber :: !Integer
} deriving (Eq) } deriving (Eq)
instance Show DigitGrp where instance Show DigitGrp where