Permalink
Browse files

hlint, ghc warning fixes: imports, type definitions, etc

  • Loading branch information...
1 parent 617688a commit 52794b6dbf051e73e7acdbe1ab2c1094cfdc6ba0 @temoto committed Nov 28, 2012
Showing with 74 additions and 54 deletions.
  1. +15 −9 NginxLint/Data.hs
  2. +22 −12 NginxLint/Hint.hs
  3. +12 −13 NginxLint/Main.hs
  4. +25 −20 NginxLint/Parse.hs
View
@@ -1,10 +1,9 @@
{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses #-}
module NginxLint.Data where
-import Data.Data
-import Data.Generics.Str
-import Data.Generics.Uniplate.Operations
-import Data.List (intercalate)
+import Data.Data (Data, Typeable)
+import Data.Generics.Str (listStr, strList, Str(Zero))
+import Data.Generics.Uniplate.Operations (Biplate, biplate, Uniplate, uniplate)
import qualified Text.ParserCombinators.Parsec as P
@@ -30,10 +29,10 @@ instance Biplate NgFile Decl where
biplate (NgFile fname ds) = (listStr ds, \newds -> NgFile fname (strList newds))
instance Uniplate Decl where
- uniplate d@(Decl _ _ _) = (Zero, \Zero -> d)
- uniplate d@(Block pos ident args children) = (listStr children, \newds -> Block pos ident args (strList newds))
- uniplate d@(If pos args children) = (listStr children, \newds -> If pos args (strList newds))
- uniplate d@(Location pos args children) = (listStr children, \newds -> If pos args (strList newds))
+ uniplate d@Decl{} = (Zero, \Zero -> d)
+ uniplate (Block pos ident args children) = (listStr children, \newds -> Block pos ident args (strList newds))
+ uniplate (If pos args children) = (listStr children, \newds -> If pos args (strList newds))
+ uniplate (Location pos args children) = (listStr children, \newds -> If pos args (strList newds))
class NgPositioned a where
@@ -48,6 +47,8 @@ instance NgPositioned Arg where
instance NgPositioned Decl where
ng_getPosition (Decl pos _ _) = pos
ng_getPosition (Block pos _ _ _) = pos
+ ng_getPosition (If pos _ _) = pos
+ ng_getPosition (Location pos _ _) = pos
-- Hint where, category, id, content
@@ -59,28 +60,33 @@ instance NgPositioned Hint where
-- pretty print for P.SourcePos
+ppSrcPos :: P.SourcePos -> String
ppSrcPos pos = P.sourceName pos ++ ":" ++ show (P.sourceLine pos)
++ ":" ++ show (P.sourceColumn pos)
-- pretty print for Arg
+ppArg :: Arg -> String
ppArg (RawString _ s) = s
ppArg (QuotedString _ s) = "\"" ++ s ++ "\""
ppArg (Integer _ i) = show i
+ppArgList :: [Arg] -> String
ppArgList = concatMap (\a -> " " ++ ppArg a)
-- pretty print for Decl
+ppDecl :: Decl -> String
ppDecl (Decl _ name args ) = name ++ ppArgList args ++ ";\n"
ppDecl (Block _ name args ds) = name ++ ppArgList args ++ " {\n"
++ concatMap (\d -> " " ++ ppDecl d) ds
++ "}\n"
-ppDecl (If pos args ds) = "if ( " ++ ppArgList args ++ " ) {\n"
+ppDecl (If _ args ds) = "if ( " ++ ppArgList args ++ " ) {\n"
++ concatMap (\d -> " " ++ ppDecl d) ds
++ "}\n"
ppDecl (Location pos args ds) = ppDecl $ Block pos "location" args ds
-- pretty print for Hint
+ppHint :: Hint -> String
ppHint h@(Hint _ cat ident content) = ppSrcPos pos ++ " "
++ cat ++ ":" ++ ident ++ ": " ++ content
where pos = ng_getPosition h
View
@@ -1,12 +1,14 @@
-module NginxLint.Hint where
+module NginxLint.Hint (
+ analyzeDecl
+) where
-import Data.List
-import Data.Maybe
-import Debug.Trace
+import Data.List (isPrefixOf, isInfixOf)
+import Data.Maybe (mapMaybe)
+--import Debug.Trace (trace)
import qualified Text.ParserCombinators.Parsec as P
import NginxLint.Data
-import NginxLint.Parse
+import NginxLint.Parse (plainString)
argHints :: [Arg -> Maybe Hint]
@@ -22,16 +24,21 @@ analyzeDecl d = mapMaybe (\f -> f d) declHints
++ concatMap analyzeArg (extractDeclArgs d)
where extractDeclArgs (Decl _ _ args) = args
extractDeclArgs (Block _ _ args _) = args
+ extractDeclArgs (If _ args _) = args
+ extractDeclArgs (Location _ args _) = args
analyzeArg :: Arg -> [Hint]
analyzeArg arg = mapMaybe (\f -> f arg) argHints
-declIsLocation (Block _ "location" _ _) = True
-declIsLocation _ = False
+-- Not used yet.
+--declIsLocation :: Decl -> Bool
+--declIsLocation (Block _ "location" _ _) = True
+--declIsLocation _ = False
-isLocationRegex (Block _ "location" [RawString _ op, _] _) = op `elem` ["~", "~*"]
-isLocationRegex _ = False
+--isLocationRegex :: Decl -> Bool
+--isLocationRegex (Block _ "location" [RawString _ op, _] _) = op `elem` ["~", "~*"]
+--isLocationRegex _ = False
hintDeclPrefixRegexNoCaptures :: Decl -> Maybe Hint
@@ -44,9 +51,10 @@ hintDeclPrefixRegexNoCaptures decl@(Block _ "location" [RawString _ op, RawStrin
hintDeclPrefixRegexNoCaptures _ = Nothing
-hintDeclIfFilename :: Decl -> Maybe Hint
-hintDeclIfFilename decl@(Block _ "if" args _) = trace (show decl) Nothing
-hintDeclIfFilename _ = Nothing
+-- Not used yet.
+--hintDeclIfFilename :: Decl -> Maybe Hint
+--hintDeclIfFilename decl@(Block _ "if" _ _) = trace (show decl) Nothing
+--hintDeclIfFilename _ = Nothing
hintArgExcessiveQuot :: Arg -> Maybe Hint
@@ -56,4 +64,6 @@ hintArgExcessiveQuot arg@(QuotedString _ qs) =
Right (RawString _ s)
| s == qs -> Just $ Hint (ng_getPosition arg) "Arg" "eq" ("Excessive quoting: \"" ++ qs ++ "\"")
| otherwise -> Nothing
+ -- GHC warns there is non-exhaustive match, missing QuotedString and Integer.
+ -- But it seems impossible to get anything other than RawString or parsing error from plainString.
hintArgExcessiveQuot _ = Nothing
View
@@ -1,22 +1,22 @@
-module Main where
+module Main (main) where
-import Data.Generics.Uniplate.Operations
-import System.Environment
-import System.Exit
-import System.IO
+import Data.Generics.Uniplate.Operations (universeBi)
+import System.Environment (getArgs)
+import System.Exit (exitFailure)
import Text.ParserCombinators.Parsec (parseFromFile)
-import NginxLint.Data
-import NginxLint.Hint
-import NginxLint.Parse
+import NginxLint.Data (NgFile(..), ppDecl, ppHint)
+import NginxLint.Hint (analyzeDecl)
+import NginxLint.Parse (parseFile)
+main :: IO ()
main = processFiles
processFiles :: IO ()
processFiles = do
args <- getArgs
- if length args >= 1 && head args == "-print"
+ if not (null args) && head args == "-print"
then mapM_ (processFile printParsed) (tail args)
else mapM_ (processFile processHints) args
@@ -30,14 +30,13 @@ processFile fun fname = do
Right ngfile -> fun ngfile
processHints :: NgFile -> IO ()
-processHints f@(NgFile fname _) = do_hints
+processHints f@(NgFile fname _) = doHints
where
- do_hints = if null hints
+ doHints = if null hints
then putStrLn (fname ++ ": No suggestions.")
else mapM_ (putStrLn . ppHint) hints
- all_decls = universeBi f
- hints = concatMap analyzeDecl all_decls
+ hints = concatMap analyzeDecl (universeBi f)
printParsed :: NgFile -> IO ()
printParsed (NgFile fname decls) = do
View
@@ -1,6 +1,5 @@
module NginxLint.Parse where
-import Debug.Trace
import Text.ParserCombinators.Parsec hiding (spaces)
import Text.ParserCombinators.Parsec.Language (emptyDef)
import qualified Text.ParserCombinators.Parsec.Token as T
@@ -18,46 +17,52 @@ parseFile = do whiteSpace
decl :: Parser Decl
decl = try ifDecl <|> nonIfDecl
+nonIfDecl :: Parser Decl
nonIfDecl = try blockDecl <|> oneDecl
+oneDecl :: Parser Decl
oneDecl = do whiteSpace
pos <- getPosition
name <- identifier
args <- many argument
- lexeme (char ';')
+ _ <- lexeme (char ';')
return $ Decl pos name args
<?> "directive"
+blockDecl :: Parser Decl
blockDecl = do whiteSpace
pos <- getPosition
name <- identifier
args <- try (many argument)
ds <- braces (many decl)
return $ Block pos name args ds
+ifDecl :: Parser Decl
ifDecl = do whiteSpace
pos <- getPosition
reserved "if"
- symbol "("
+ _ <- symbol "("
args <- argument `manyTill` try (symbol ")")
ds <- braces (many nonIfDecl)
return $ Block pos "if" args ds
argument :: Parser Arg
-argument = quotedString <|> plainString
- <|> parseInteger
+argument = parseInteger <|> quotedString <|> plainString
<?> "directive argument"
+parseInteger :: Parser Arg
parseInteger = do pos <- getPosition
n <- integer
return $ Integer pos n
+quotedString :: Parser Arg
quotedString = do pos <- getPosition
- symbol "\""
+ _ <- symbol "\""
s <- many (noneOf "\"")
- symbol "\""
+ _ <- symbol "\""
return $ QuotedString pos s
+plainString :: Parser Arg
plainString = do pos <- getPosition
s <- lexeme ps
return $ RawString pos s
@@ -75,19 +80,19 @@ nginxDef = emptyDef
, T.reservedNames = ["if"]
}
-whiteSpace = T.whiteSpace lexer
-lexeme = T.lexeme lexer
-symbol = T.symbol lexer
braces = T.braces lexer
-natural = T.natural lexer
-float = T.float lexer
-integer = T.natural lexer
-parens = T.parens lexer
-comma = T.comma lexer
-semi = T.semi lexer
-dot = T.dot lexer
+--comma = T.comma lexer
+--commaSep = T.commaSep lexer
+--commaSep1 = T.commaSep1 lexer
+--dot = T.dot lexer
+--float = T.float lexer
identifier = T.identifier lexer
+integer = T.natural lexer
+lexeme = T.lexeme lexer
+--natural = T.natural lexer
+--parens = T.parens lexer
reserved = T.reserved lexer
-commaSep = T.commaSep lexer
-commaSep1 = T.commaSep1 lexer
-semiSep = T.semiSep lexer
+--semi = T.semi lexer
+--semiSep = T.semiSep lexer
+symbol = T.symbol lexer
+whiteSpace = T.whiteSpace lexer

0 comments on commit 52794b6

Please sign in to comment.