From af56ced3b0347a9ee668895932a80629be628f13 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Tue, 4 Nov 2014 04:35:25 +0100 Subject: [PATCH] lib: add eof parsing checks --- extra/hledger-rewrite.hs | 6 +++--- hledger-lib/Hledger/Data/OutputFormat.hs | 3 ++- hledger-lib/Hledger/Read/CsvReader.hs | 4 ++-- hledger-lib/Hledger/Read/JournalReader.hs | 9 +++++---- hledger/Hledger/Cli/Add.hs | 7 ++++--- hledger/Hledger/Cli/Options.hs | 4 ++-- 6 files changed, 18 insertions(+), 15 deletions(-) diff --git a/extra/hledger-rewrite.hs b/extra/hledger-rewrite.hs index fe1833966..e10b1ac10 100755 --- a/extra/hledger-rewrite.hs +++ b/extra/hledger-rewrite.hs @@ -22,7 +22,7 @@ Tested-with: hledger HEAD ~ 2014/2/4 -- hledger lib, cli and cmdargs utils import Hledger.Cli -- more utils for parsing -import Control.Applicative hiding (many) +import Control.Applicative ((<*)) hiding (many) import Text.Parsec @@ -46,7 +46,7 @@ type PostingExpr = (AccountName, AmountExpr) data AmountExpr = AmountLiteral String | AmountMultiplier Quantity deriving (Show) addPostingExprsFromOpts :: RawOpts -> [PostingExpr] -addPostingExprsFromOpts = map (either parseerror id . runParser postingexprp nullctx "") . map stripquotes . listofstringopt "add-posting" +addPostingExprsFromOpts = map (either parseerror id . runParser (postingexprp <* eof) nullctx "") . map stripquotes . listofstringopt "add-posting" postingexprp = do a <- accountnamep @@ -67,7 +67,7 @@ amountexprp = amountExprRenderer :: Query -> AmountExpr -> (Transaction -> MixedAmount) amountExprRenderer q aex = case aex of - AmountLiteral s -> either parseerror (const . mixed) $ runParser amountp nullctx "" s + AmountLiteral s -> either parseerror (const . mixed) $ runParser (amountp <* eof) nullctx "" s AmountMultiplier n -> (`divideMixedAmount` (1 / n)) . (`firstAmountMatching` q) where firstAmountMatching :: Transaction -> Query -> MixedAmount diff --git a/hledger-lib/Hledger/Data/OutputFormat.hs b/hledger-lib/Hledger/Data/OutputFormat.hs index de55aca21..630ce2ab9 100644 --- a/hledger-lib/Hledger/Data/OutputFormat.hs +++ b/hledger-lib/Hledger/Data/OutputFormat.hs @@ -8,6 +8,7 @@ module Hledger.Data.OutputFormat ( , tests ) where +import Control.Applicative ((<*)) import Numeric import Data.Char (isPrint) import Data.Maybe @@ -27,7 +28,7 @@ formatValue leftJustified min max value = printf formatS value formatS = "%" ++ l ++ min' ++ max' ++ "s" parseStringFormat :: String -> Either String [OutputFormat] -parseStringFormat input = case (runParser formatsp () "(unknown)") input of +parseStringFormat input = case (runParser (formatsp <* eof) () "(unknown)") input of Left y -> Left $ show y Right x -> Right x diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index ce086a7da..dd55f4f9f 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -19,7 +19,7 @@ module Hledger.Read.CsvReader ( tests_Hledger_Read_CsvReader ) where -import Control.Applicative ((<$>)) +import Control.Applicative ((<$>), (<*)) import Control.Exception hiding (try) import Control.Monad import Control.Monad.Error @@ -604,7 +604,7 @@ transactionFromCsvRecord sourcepos rules record = t precomment = maybe "" render $ mfieldtemplate "precomment" currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency" amountstr = (currency++) $ negateIfParenthesised $ getAmountStr rules record - amount = either amounterror (Mixed . (:[])) $ runParser (do {a <- amountp; eof; return a}) nullctx "" amountstr + amount = either amounterror (Mixed . (:[])) $ runParser (amountp <* eof) nullctx "" amountstr amounterror err = error' $ unlines ["error: could not parse \""++amountstr++"\" as an amount" ,showRecord record diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 9f7181093..d84ff32a7 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -45,6 +45,7 @@ module Hledger.Read.JournalReader ( #endif ) where +import Control.Applicative ((<*)) import qualified Control.Exception as C import Control.Monad import Control.Monad.Error @@ -541,12 +542,12 @@ postingp = do -- oh boy date <- case dateValueFromTags tags of Nothing -> return Nothing - Just v -> case runParser datep ctx "" v of + Just v -> case runParser (datep <* eof) ctx "" v of Right d -> return $ Just d Left err -> parserFail $ show err date2 <- case date2ValueFromTags tags of Nothing -> return Nothing - Just v -> case runParser datep ctx "" v of + Just v -> case runParser (datep <* eof) ctx "" v of Right d -> return $ Just d Left err -> parserFail $ show err return posting @@ -683,7 +684,7 @@ test_amountp = do -- | Parse an amount from a string, or get an error. amountp' :: String -> Amount amountp' s = - case runParser amountp nullctx "" s of + case runParser (amountp <* eof) nullctx "" s of Right t -> t Left err -> error' $ show err @@ -930,7 +931,7 @@ tagsInComment c = concatMap tagsInCommentLine $ lines c' tagsInCommentLine :: String -> [Tag] tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ',' where - maybetag s = case runParser tag nullctx "" s of + maybetag s = case runParser (tag <* eof) nullctx "" s of Right t -> Just t Left _ -> Nothing diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index 88c2b7e92..a25951405 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -8,6 +8,7 @@ A history-aware add command to help with data entry. module Hledger.Cli.Add where +import Control.Applicative ((<*)) import Control.Exception as E import Control.Monad import Control.Monad.Trans (liftIO) @@ -178,7 +179,7 @@ dateAndCodeWizard EntryState{..} = do where parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc where - edc = runParser dateandcodep nullctx "" $ lowercase s + edc = runParser (dateandcodep <* eof) nullctx "" $ lowercase s dateandcodep :: Stream [Char] m t => ParsecT [Char] JournalContext m (SmartDate, String) dateandcodep = do d <- smartdate @@ -242,7 +243,7 @@ accountWizard EntryState{..} = do parseAccountOrDotOrNull _ _ "." = dbg $ Just "." -- . always signals end of txn parseAccountOrDotOrNull "" True "" = dbg $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn parseAccountOrDotOrNull def@(_:_) _ "" = dbg $ Just def -- when there's a default, "" means use that - parseAccountOrDotOrNull _ _ s = dbg $ either (const Nothing) validateAccount $ runParser accountnamep (jContext esJournal) "" s -- otherwise, try to parse the input as an accountname + parseAccountOrDotOrNull _ _ s = dbg $ either (const Nothing) validateAccount $ runParser (accountnamep <* eof) (jContext esJournal) "" s -- otherwise, try to parse the input as an accountname dbg = id -- strace validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing | otherwise = Just s @@ -266,7 +267,7 @@ amountAndCommentWizard EntryState{..} = do maybeRestartTransaction $ line $ green $ printf "Amount %d%s: " pnum (showDefault def) where - parseAmountAndComment = either (const Nothing) Just . runParser amountandcommentp nodefcommodityctx "" + parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) nodefcommodityctx "" nodefcommodityctx = (jContext esJournal){ctxDefaultCommodityAndStyle=Nothing} amountandcommentp :: Stream [Char] m t => ParsecT [Char] JournalContext m (Amount, String) amountandcommentp = do diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 0705cd2b2..b7a4d5ca5 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -62,7 +62,7 @@ module Hledger.Cli.Options ( ) where -import Control.Applicative ((<$>)) +import Control.Applicative ((<$>), (<*)) import qualified Control.Exception as C import Control.Monad (when) import Data.List @@ -451,7 +451,7 @@ widthFromOpts CliOpts{width_=Just ""} = Right $ TotalWidth $ Width defaultWidthW widthFromOpts CliOpts{width_=Just s} = parseWidth s parseWidth :: String -> Either String OutputWidth -parseWidth s = case (runParser outputwidthp () "(unknown)") s of +parseWidth s = case (runParser (outputwidthp <* eof) () "(unknown)") s of Left e -> Left $ show e Right x -> Right x