From ce708e0972acdc9ab8aeeda2e28c14cbd94777f4 Mon Sep 17 00:00:00 2001 From: Derek Elkins Date: Wed, 13 Feb 2008 04:32:24 +0000 Subject: [PATCH] Clean most warnings --- Text/Parsec/ByteString.hs | 1 + Text/Parsec/ByteString/Lazy.hs | 1 + Text/Parsec/Char.hs | 2 +- Text/Parsec/Combinator.hs | 2 +- Text/Parsec/Error.hs | 11 ++++---- Text/Parsec/Perm.hs | 12 ++++----- Text/Parsec/Pos.hs | 22 ++++++++-------- Text/Parsec/Prim.hs | 46 ++++++++++++++++++---------------- Text/Parsec/String.hs | 1 + Text/Parsec/Token.hs | 1 + 10 files changed, 52 insertions(+), 47 deletions(-) diff --git a/Text/Parsec/ByteString.hs b/Text/Parsec/ByteString.hs index c4deab9..d87daf0 100644 --- a/Text/Parsec/ByteString.hs +++ b/Text/Parsec/ByteString.hs @@ -13,6 +13,7 @@ ----------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Parsec.ByteString ( Parser, GenParser, parseFromFile diff --git a/Text/Parsec/ByteString/Lazy.hs b/Text/Parsec/ByteString/Lazy.hs index a7f1a38..ae541fe 100644 --- a/Text/Parsec/ByteString/Lazy.hs +++ b/Text/Parsec/ByteString/Lazy.hs @@ -13,6 +13,7 @@ ----------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Parsec.ByteString.Lazy ( Parser, GenParser, parseFromFile diff --git a/Text/Parsec/Char.hs b/Text/Parsec/Char.hs index 3e0448a..3f93951 100644 --- a/Text/Parsec/Char.hs +++ b/Text/Parsec/Char.hs @@ -122,7 +122,7 @@ anyChar = satisfy (const True) satisfy :: (Stream s m Char) => (Char -> Bool) -> ParsecT s u m Char satisfy f = tokenPrim (\c -> show [c]) - (\pos c cs -> updatePosChar pos c) + (\pos c _cs -> updatePosChar pos c) (\c -> if f c then Just c else Nothing) -- | @string s@ parses a sequence of characters given by @s@. Returns diff --git a/Text/Parsec/Combinator.hs b/Text/Parsec/Combinator.hs index 8db58a9..2ac2d81 100644 --- a/Text/Parsec/Combinator.hs +++ b/Text/Parsec/Combinator.hs @@ -231,7 +231,7 @@ chainr1 p op = scan -- used to implement 'eof'. Returns the accepted token. anyToken :: (Stream s m t, Show t) => ParsecT s u m t -anyToken = tokenPrim show (\pos tok toks -> pos) Just +anyToken = tokenPrim show (\pos _tok _toks -> pos) Just -- | This parser only succeeds at the end of the input. This is not a -- primitive parser but it is defined using 'notFollowedBy'. diff --git a/Text/Parsec/Error.hs b/Text/Parsec/Error.hs index 2f03f2d..a2d0a5b 100644 --- a/Text/Parsec/Error.hs +++ b/Text/Parsec/Error.hs @@ -98,17 +98,17 @@ data ParseError = ParseError !SourcePos [Message] -- | Extracts the source position from the parse error errorPos :: ParseError -> SourcePos -errorPos (ParseError pos msgs) +errorPos (ParseError pos _msgs) = pos -- | Extracts the list of error messages from the parse error errorMessages :: ParseError -> [Message] -errorMessages (ParseError pos msgs) +errorMessages (ParseError _pos msgs) = sort msgs errorIsUnknown :: ParseError -> Bool -errorIsUnknown (ParseError pos msgs) +errorIsUnknown (ParseError _pos msgs) = null msgs -- < Create parse errors @@ -189,10 +189,9 @@ showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs commasOr ms = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms commaSep = seperate ", " . clean - semiSep = seperate "; " . clean - seperate sep [] = "" - seperate sep [m] = m + seperate _ [] = "" + seperate _ [m] = m seperate sep (m:ms) = m ++ sep ++ seperate sep ms clean = nub . filter (not . null) diff --git a/Text/Parsec/Perm.hs b/Text/Parsec/Perm.hs index 06d9a16..0399aa5 100644 --- a/Text/Parsec/Perm.hs +++ b/Text/Parsec/Perm.hs @@ -30,7 +30,6 @@ module Text.Parsec.Perm ) where import Text.Parsec -import Text.Parsec.String import Control.Monad.Identity @@ -44,6 +43,7 @@ infixl 2 <$$>, <$?> * a required 'b' * an optional 'c' ---------------------------------------------------------------} +{- test input = parse (do{ x <- ptest; eof; return x }) "" input @@ -53,7 +53,7 @@ ptest (,,) <$?> ("",many1 (char 'a')) <||> char 'b' <|?> ('_',char 'c') - +-} {--------------------------------------------------------------- Building a permutation parser @@ -120,7 +120,7 @@ type PermParser tok st a = StreamPermParser String st a data StreamPermParser s st a = Perm (Maybe a) [StreamBranch s st a] -type Branch st a = StreamBranch String st a +-- type Branch st a = StreamBranch String st a data StreamBranch s st a = forall b. Branch (StreamPermParser s st (b -> a)) (Parsec s st b) @@ -157,7 +157,7 @@ newperm f = Perm (Just f) [] add :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b -add perm@(Perm mf fs) p +add perm@(Perm _mf fs) p = Perm Nothing (first:map insert fs) where first = Branch perm p @@ -175,7 +175,7 @@ addopt perm@(Perm mf fs) x p mapPerms :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st a -> StreamPermParser s st b mapPerms f (Perm x xs) - = Perm (fmap f x) (map (mapBranch f) xs) + = Perm (fmap f x) (map mapBranch xs) where - mapBranch f (Branch perm p) + mapBranch (Branch perm p) = Branch (mapPerms (f.) perm) p diff --git a/Text/Parsec/Pos.hs b/Text/Parsec/Pos.hs index 9b020f4..7bc26ad 100644 --- a/Text/Parsec/Pos.hs +++ b/Text/Parsec/Pos.hs @@ -41,30 +41,30 @@ data SourcePos = SourcePos SourceName !Line !Column -- line number and column number. newPos :: SourceName -> Line -> Column -> SourcePos -newPos sourceName line column - = SourcePos sourceName line column +newPos name line column + = SourcePos name line column -- | Create a new 'SourcePos' with the given source name, -- and line number and column number set to 1, the upper left. initialPos :: SourceName -> SourcePos -initialPos sourceName - = newPos sourceName 1 1 +initialPos name + = newPos name 1 1 -- | Extracts the name of the source from a source position. sourceName :: SourcePos -> SourceName -sourceName (SourcePos name line column) = name +sourceName (SourcePos name _line _column) = name -- | Extracts the line number from a source position. sourceLine :: SourcePos -> Line -sourceLine (SourcePos name line column) = line +sourceLine (SourcePos _name line _column) = line -- | Extracts the column number from a source position. sourceColumn :: SourcePos -> Column -sourceColumn (SourcePos name line column) = column +sourceColumn (SourcePos _name _line column) = column -- | Increments the line number of a source position. @@ -79,17 +79,17 @@ incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n) -- | Set the name of the source. setSourceName :: SourcePos -> SourceName -> SourcePos -setSourceName (SourcePos name line column) n = SourcePos n line column +setSourceName (SourcePos _name line column) n = SourcePos n line column -- | Set the line number of a source position. setSourceLine :: SourcePos -> Line -> SourcePos -setSourceLine (SourcePos name line column) n = SourcePos name n column +setSourceLine (SourcePos name _line column) n = SourcePos name n column -- | Set the column number of a source position. setSourceColumn :: SourcePos -> Column -> SourcePos -setSourceColumn (SourcePos name line column) n = SourcePos name line n +setSourceColumn (SourcePos name line _column) n = SourcePos name line n -- | The expression @updatePosString pos s@ updates the source position -- @pos@ by calling 'updatePosChar' on every character in @s@, ie. @@ -107,7 +107,7 @@ updatePosString pos string -- incremented by 1. updatePosChar :: SourcePos -> Char -> SourcePos -updatePosChar pos@(SourcePos name line column) c +updatePosChar (SourcePos name line column) c = case c of '\n' -> SourcePos name (line+1) 1 '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8)) diff --git a/Text/Parsec/Prim.hs b/Text/Parsec/Prim.hs index 48dbc73..5380fca 100644 --- a/Text/Parsec/Prim.hs +++ b/Text/Parsec/Prim.hs @@ -18,7 +18,7 @@ module Text.Parsec.Prim where import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) ) -import Control.Monad +import Control.Monad() import Control.Monad.Trans import Control.Monad.Identity @@ -30,8 +30,10 @@ import Control.Monad.Error.Class import Text.Parsec.Pos import Text.Parsec.Error +unknownError :: State s u -> ParseError unknownError state = newErrorUnknown (statePos state) +sysUnExpectError :: String -> SourcePos -> Reply s u a sysUnExpectError msg pos = Error (newErrorMessage (SysUnExpect msg) pos) -- | The parser @unexpected msg@ always fails with an unexpected error @@ -75,7 +77,7 @@ instance Functor Consumed where instance Functor (Reply s u) where fmap f (Ok x s e) = Ok (f x) s e - fmap f (Error e) = Error e -- XXX + fmap _ (Error e) = Error e -- XXX instance (Monad m) => Functor (ParsecT s u m) where fmap f p = parsecMap f p @@ -97,7 +99,6 @@ instance (Monad m) => Monad (ParsecT s u m) where p >>= f = parserBind p f fail msg = parserFail msg - instance (MonadIO m) => MonadIO (ParsecT s u m) where liftIO = lift . liftIO @@ -132,7 +133,7 @@ parserBind :: (Monad m) => ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b parserBind p f - = ParsecT $ \s@(State _ u _) -> do + = ParsecT $ \s -> do -- TODO: This was \s@(State _ u _) ??? res1 <- runParsecT p s case res1 of @@ -164,6 +165,7 @@ parserBind p f Error err1 -> return $ Error err1 +mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a mergeErrorReply err1 reply -- XXX where to put it? = case reply of Ok x state err2 -> Ok x state (mergeError err1 err2) @@ -268,7 +270,7 @@ labels p msgs setExpectErrors err [] = setErrorMessage (Expect "") err setExpectErrors err [msg] = setErrorMessage (Expect msg) err setExpectErrors err (msg:msgs) - = foldr (\msg err -> addErrorMessage (Expect msg) err) + = foldr (\msg' err' -> addErrorMessage (Expect msg') err') (setErrorMessage (Expect msg) err) msgs -- | An instance of @Stream@ has stream type @s@, underlying monad @m@ and token type @t@ determined by the stream @@ -282,13 +284,13 @@ tokens :: (Stream s m t, Eq t) -> ParsecT s u m [t] tokens _ _ [] = ParsecT $ \s -> return $ Empty $ return $ Ok [] s (unknownError s) -tokens shows nextposs tts@(t:ts) - = ParsecT $ \s@(State input pos u) -> +tokens showTokens nextposs tts@(tok:toks) + = ParsecT $ \(State input pos u) -> let - errEof = return $ Error (setErrorMessage (Expect (shows tts)) + errEof = return $ Error (setErrorMessage (Expect (showTokens tts)) (newErrorMessage (SysUnExpect "") pos)) - errExpect x = return $ Error (setErrorMessage (Expect (shows tts)) - (newErrorMessage (SysUnExpect (shows [x])) pos)) + errExpect x = return $ Error (setErrorMessage (Expect (showTokens tts)) + (newErrorMessage (SysUnExpect (showTokens [x])) pos)) walk [] rs = return (ok rs) walk (t:ts) rs = do sr <- uncons rs @@ -304,7 +306,7 @@ tokens shows nextposs tts@(t:ts) return $ case sr of Nothing -> Empty $ errEof Just (x,xs) - | t == x -> Consumed $ walk ts xs + | tok == x -> Consumed $ walk toks xs | otherwise -> Empty $ errExpect x -- | The parser @try p@ behaves like parser @p@, except that it @@ -372,7 +374,7 @@ token :: (Stream s Identity t) -> (t -> SourcePos) -- ^ Computes the position of a token. -> (t -> Maybe a) -- ^ Matching function for the token to parse. -> Parsec s u a -token show tokpos test = tokenPrim show nextpos test +token showToken tokpos test = tokenPrim showToken nextpos test where nextpos _ tok ts = case runIdentity (uncons ts) of Nothing -> tokpos tok @@ -400,7 +402,7 @@ tokenPrim :: (Stream s m t) -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function. -> (t -> Maybe a) -- ^ Matching function for the token to parse. -> ParsecT s u m a -tokenPrim show nextpos test = tokenPrimEx show nextpos Nothing test +tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test tokenPrimEx :: (Stream s m t) => (t -> String) @@ -408,10 +410,10 @@ tokenPrimEx :: (Stream s m t) -> Maybe (SourcePos -> t -> s -> u -> u) -> (t -> Maybe a) -> ParsecT s u m a -tokenPrimEx show nextpos mbNextState test +tokenPrimEx showToken nextpos mbNextState test = case mbNextState of Nothing - -> ParsecT $ \s@(State input pos user) -> do + -> ParsecT $ \(State input pos user) -> do r <- uncons input case r of Nothing -> return $ Empty $ return (sysUnExpectError "" pos) @@ -423,9 +425,9 @@ tokenPrimEx show nextpos mbNextState test return $ Consumed $ return $ (Ok x newstate (newErrorUnknown newpos)) Nothing -> return $ Empty $ return $ - (sysUnExpectError (show c) pos) + (sysUnExpectError (showToken c) pos) Just nextState - -> ParsecT $ \s@(State input pos user) -> do + -> ParsecT $ \(State input pos user) -> do r <- uncons input case r of Nothing -> return $ Empty $ return (sysUnExpectError "" pos) @@ -438,7 +440,7 @@ tokenPrimEx show nextpos mbNextState test return $ Consumed $ return $ (Ok x newstate (newErrorUnknown newpos)) Nothing -> return $ Empty $ return $ - (sysUnExpectError (show c) pos) + (sysUnExpectError (showToken c) pos) -- | @many p@ applies the parser @p@ /zero/ or more times. Returns a -- list of the returned values of @p@. @@ -460,7 +462,7 @@ many p skipMany :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m () skipMany p - = do manyAccum (\x xs -> []) p + = do manyAccum (\_ _ -> []) p return () manyAccum :: (Stream s m t) @@ -476,13 +478,13 @@ manyAccum accum p -> do reply <- mReply case reply of Error err -> return $ Ok xs state err - ok -> error "Text.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string." + _ -> error "Text.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string." Consumed mReply -> do reply <- mReply case reply of Error err -> return $ Error err - Ok x s' err + Ok x s' _err -> let ys = accum x xs in seq ys (walk ys s' (runParsecT p s')) in do r <- runParsecT p s @@ -490,7 +492,7 @@ manyAccum accum p Empty mReply -> do reply <- mReply case reply of - Ok x s' err + Ok _ _ _ -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string." Error err -> return $ Empty $ return (Ok [] s err) diff --git a/Text/Parsec/String.hs b/Text/Parsec/String.hs index c0486fa..20ec1a8 100644 --- a/Text/Parsec/String.hs +++ b/Text/Parsec/String.hs @@ -13,6 +13,7 @@ ----------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Parsec.String ( Parser, GenParser, parseFromFile diff --git a/Text/Parsec/Token.hs b/Text/Parsec/Token.hs index 432608b..2b1c032 100644 --- a/Text/Parsec/Token.hs +++ b/Text/Parsec/Token.hs @@ -14,6 +14,7 @@ ----------------------------------------------------------------------------- {-# LANGUAGE PolymorphicComponents #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Text.Parsec.Token ( LanguageDef