lib: add eof parsing checks
This commit is contained in:
		
							parent
							
								
									a575de9806
								
							
						
					
					
						commit
						af56ced3b0
					
				| @ -22,7 +22,7 @@ Tested-with: hledger HEAD ~ 2014/2/4 | |||||||
| -- hledger lib, cli and cmdargs utils | -- hledger lib, cli and cmdargs utils | ||||||
| import Hledger.Cli | import Hledger.Cli | ||||||
| -- more utils for parsing | -- more utils for parsing | ||||||
| import Control.Applicative hiding (many) | import Control.Applicative ((<*)) hiding (many) | ||||||
| import Text.Parsec | import Text.Parsec | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| @ -46,7 +46,7 @@ type PostingExpr = (AccountName, AmountExpr) | |||||||
| data AmountExpr = AmountLiteral String | AmountMultiplier Quantity deriving (Show) | data AmountExpr = AmountLiteral String | AmountMultiplier Quantity deriving (Show) | ||||||
| 
 | 
 | ||||||
| addPostingExprsFromOpts :: RawOpts -> [PostingExpr] | 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 | postingexprp = do | ||||||
|   a <- accountnamep |   a <- accountnamep | ||||||
| @ -67,7 +67,7 @@ amountexprp = | |||||||
| amountExprRenderer :: Query -> AmountExpr -> (Transaction -> MixedAmount) | amountExprRenderer :: Query -> AmountExpr -> (Transaction -> MixedAmount) | ||||||
| amountExprRenderer q aex = | amountExprRenderer q aex = | ||||||
|   case aex of |   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) |     AmountMultiplier n -> (`divideMixedAmount` (1 / n)) . (`firstAmountMatching` q) | ||||||
|   where |   where | ||||||
|     firstAmountMatching :: Transaction -> Query -> MixedAmount |     firstAmountMatching :: Transaction -> Query -> MixedAmount | ||||||
|  | |||||||
| @ -8,6 +8,7 @@ module Hledger.Data.OutputFormat ( | |||||||
|         , tests |         , tests | ||||||
|         ) where |         ) where | ||||||
| 
 | 
 | ||||||
|  | import Control.Applicative ((<*)) | ||||||
| import Numeric | import Numeric | ||||||
| import Data.Char (isPrint) | import Data.Char (isPrint) | ||||||
| import Data.Maybe | import Data.Maybe | ||||||
| @ -27,7 +28,7 @@ formatValue leftJustified min max value = printf formatS value | |||||||
|       formatS = "%" ++ l ++ min' ++ max' ++ "s" |       formatS = "%" ++ l ++ min' ++ max' ++ "s" | ||||||
| 
 | 
 | ||||||
| parseStringFormat :: String -> Either String [OutputFormat] | 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 |     Left y -> Left $ show y | ||||||
|     Right x -> Right x |     Right x -> Right x | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -19,7 +19,7 @@ module Hledger.Read.CsvReader ( | |||||||
|   tests_Hledger_Read_CsvReader |   tests_Hledger_Read_CsvReader | ||||||
| ) | ) | ||||||
| where | where | ||||||
| import Control.Applicative ((<$>)) | import Control.Applicative ((<$>), (<*)) | ||||||
| import Control.Exception hiding (try) | import Control.Exception hiding (try) | ||||||
| import Control.Monad | import Control.Monad | ||||||
| import Control.Monad.Error | import Control.Monad.Error | ||||||
| @ -604,7 +604,7 @@ transactionFromCsvRecord sourcepos rules record = t | |||||||
|     precomment  = maybe "" render $ mfieldtemplate "precomment" |     precomment  = maybe "" render $ mfieldtemplate "precomment" | ||||||
|     currency    = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency" |     currency    = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency" | ||||||
|     amountstr   = (currency++) $ negateIfParenthesised $ getAmountStr rules record |     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 |     amounterror err = error' $ unlines | ||||||
|       ["error: could not parse \""++amountstr++"\" as an amount" |       ["error: could not parse \""++amountstr++"\" as an amount" | ||||||
|       ,showRecord record |       ,showRecord record | ||||||
|  | |||||||
| @ -45,6 +45,7 @@ module Hledger.Read.JournalReader ( | |||||||
| #endif | #endif | ||||||
| ) | ) | ||||||
| where | where | ||||||
|  | import Control.Applicative ((<*)) | ||||||
| import qualified Control.Exception as C | import qualified Control.Exception as C | ||||||
| import Control.Monad | import Control.Monad | ||||||
| import Control.Monad.Error | import Control.Monad.Error | ||||||
| @ -541,12 +542,12 @@ postingp = do | |||||||
|   -- oh boy |   -- oh boy | ||||||
|   date <- case dateValueFromTags tags of |   date <- case dateValueFromTags tags of | ||||||
|         Nothing -> return Nothing |         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 |                     Right d -> return $ Just d | ||||||
|                     Left err -> parserFail $ show err |                     Left err -> parserFail $ show err | ||||||
|   date2 <- case date2ValueFromTags tags of |   date2 <- case date2ValueFromTags tags of | ||||||
|         Nothing -> return Nothing |         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 |                     Right d -> return $ Just d | ||||||
|                     Left err -> parserFail $ show err |                     Left err -> parserFail $ show err | ||||||
|   return posting |   return posting | ||||||
| @ -683,7 +684,7 @@ test_amountp = do | |||||||
| -- | Parse an amount from a string, or get an error. | -- | Parse an amount from a string, or get an error. | ||||||
| amountp' :: String -> Amount | amountp' :: String -> Amount | ||||||
| amountp' s = | amountp' s = | ||||||
|   case runParser amountp nullctx "" s of |   case runParser (amountp <* eof) nullctx "" s of | ||||||
|     Right t -> t |     Right t -> t | ||||||
|     Left err -> error' $ show err |     Left err -> error' $ show err | ||||||
| 
 | 
 | ||||||
| @ -930,7 +931,7 @@ tagsInComment c = concatMap tagsInCommentLine $ lines c' | |||||||
| tagsInCommentLine :: String -> [Tag] | tagsInCommentLine :: String -> [Tag] | ||||||
| tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ',' | tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ',' | ||||||
|   where |   where | ||||||
|     maybetag s = case runParser tag nullctx "" s of |     maybetag s = case runParser (tag <* eof) nullctx "" s of | ||||||
|                   Right t -> Just t |                   Right t -> Just t | ||||||
|                   Left _ -> Nothing |                   Left _ -> Nothing | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -8,6 +8,7 @@ A history-aware add command to help with data entry. | |||||||
| module Hledger.Cli.Add | module Hledger.Cli.Add | ||||||
| where | where | ||||||
| 
 | 
 | ||||||
|  | import Control.Applicative ((<*)) | ||||||
| import Control.Exception as E | import Control.Exception as E | ||||||
| import Control.Monad | import Control.Monad | ||||||
| import Control.Monad.Trans (liftIO) | import Control.Monad.Trans (liftIO) | ||||||
| @ -178,7 +179,7 @@ dateAndCodeWizard EntryState{..} = do | |||||||
|     where |     where | ||||||
|       parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc |       parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc | ||||||
|           where |           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 :: Stream [Char] m t => ParsecT [Char] JournalContext m (SmartDate, String) | ||||||
|             dateandcodep = do |             dateandcodep = do | ||||||
|                 d <- smartdate |                 d <- smartdate | ||||||
| @ -242,7 +243,7 @@ accountWizard EntryState{..} = do | |||||||
|       parseAccountOrDotOrNull _  _ "."       = dbg $ Just "." -- . always signals end of txn |       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 "" 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 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 |       dbg = id -- strace | ||||||
|       validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing |       validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing | ||||||
|                         | otherwise = Just s |                         | otherwise = Just s | ||||||
| @ -266,7 +267,7 @@ amountAndCommentWizard EntryState{..} = do | |||||||
|    maybeRestartTransaction $ |    maybeRestartTransaction $ | ||||||
|    line $ green $ printf "Amount  %d%s: " pnum (showDefault def) |    line $ green $ printf "Amount  %d%s: " pnum (showDefault def) | ||||||
|     where |     where | ||||||
|       parseAmountAndComment = either (const Nothing) Just . runParser amountandcommentp nodefcommodityctx "" |       parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) nodefcommodityctx "" | ||||||
|       nodefcommodityctx = (jContext esJournal){ctxDefaultCommodityAndStyle=Nothing} |       nodefcommodityctx = (jContext esJournal){ctxDefaultCommodityAndStyle=Nothing} | ||||||
|       amountandcommentp :: Stream [Char] m t => ParsecT [Char] JournalContext m (Amount, String) |       amountandcommentp :: Stream [Char] m t => ParsecT [Char] JournalContext m (Amount, String) | ||||||
|       amountandcommentp = do |       amountandcommentp = do | ||||||
|  | |||||||
| @ -62,7 +62,7 @@ module Hledger.Cli.Options ( | |||||||
| ) | ) | ||||||
| where | where | ||||||
| 
 | 
 | ||||||
| import Control.Applicative ((<$>)) | import Control.Applicative ((<$>), (<*)) | ||||||
| import qualified Control.Exception as C | import qualified Control.Exception as C | ||||||
| import Control.Monad (when) | import Control.Monad (when) | ||||||
| import Data.List | import Data.List | ||||||
| @ -451,7 +451,7 @@ widthFromOpts CliOpts{width_=Just ""} = Right $ TotalWidth $ Width defaultWidthW | |||||||
| widthFromOpts CliOpts{width_=Just s}  = parseWidth s | widthFromOpts CliOpts{width_=Just s}  = parseWidth s | ||||||
| 
 | 
 | ||||||
| parseWidth :: String -> Either String OutputWidth | 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 |     Left  e -> Left $ show e | ||||||
|     Right x -> Right x |     Right x -> Right x | ||||||
| 
 | 
 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user