Parser did not support regexp in directives (GH-2)

#2

Also:
- added Travis build
- removed HUnit dependency
- added tests
- gitignore cabal files

.gitignore

@@ -1,2 +1,4 @@
-dist/
 *.hi
+.cabal-sandbox/
+cabal.sandbox.config
+dist/

.travis.yml

@@ -0,0 +1,10 @@
+language: haskell
+ghc:
+  - 7.8
+  - 7.6
+  - 7.4
+
+notifications:
+  email: true
+# enable fast container runtime
+sudo: false

NginxLint/Parse.hs

@@ -33,22 +33,26 @@ blockDecl :: Parser Decl
 blockDecl = do whiteSpace
                pos <- getPosition
                name <- identifier
-               args <- try (many argument)
+               args <- many argument
                ds <- braces (many decl)
                return $ Block pos name args ds
+            <?> "block directive"
 
 ifDecl :: Parser Decl
 ifDecl = do whiteSpace
             pos <- getPosition
             reserved "if"
-            _ <- symbol "("
-            args <- argument `manyTill` try (symbol ")")
-            ds <- braces (many nonIfDecl)
+            args <- parens $ many1 ifArgument
+            ds <- braces $ many nonIfDecl
             return $ Block pos "if" args ds
+         <?> "if directive"
+    where
+        ifArgument = try parseInteger <|> try quotedString <|> plain
+            <?> "if argument"
+        plain = mkString " \"\v\t\r\n(){};" "if plain string"
 
 argument :: Parser Arg
-argument = parseInteger <|> quotedString <|> plainString
-        <?> "directive argument"
+argument = try parseInteger <|> try quotedString <|> plainString
 
 parseInteger :: Parser Arg
 parseInteger = do pos <- getPosition
@@ -57,24 +61,29 @@ parseInteger = do pos <- getPosition
 
 quotedString :: Parser Arg
 quotedString = do pos <- getPosition
-                  _ <- symbol "\""
-                  s <- many (noneOf "\"")
-                  _ <- symbol "\""
+                  _ <- symbol q
+                  s <- many (noneOf q)
+                  _ <- symbol q
                   return $ QuotedString pos s
+    where q = "\""
 
-plainString :: Parser Arg
-plainString = do pos <- getPosition
-                 s <- lexeme ps
-                 return $ RawString pos s
-              <?> "plain string"
-    where ps = many1 (noneOf " \"\v\t\r\n(){};")
+mkString :: String -> String -> Parser Arg
+mkString excl help = p <?> help
+    where
+        p = do
+            pos <- getPosition
+            s <- lexeme $ many1 (noneOf excl)
+            return $ RawString pos s
+
+plainString = mkString " \"\v\t\r\n{};" "plain string"
 
 
 lexer :: T.TokenParser ()
 lexer = T.makeTokenParser nginxDef
 
 nginxDef = emptyDef
     { T.commentLine    = "#"
+    , T.identStart     = alphaNum <|> char '_'
     , T.nestedComments = False
     , T.opLetter       = oneOf "<=>"
     , T.reservedNames  = ["if"]
@@ -90,7 +99,7 @@ identifier    = T.identifier lexer
 integer       = T.natural lexer
 lexeme        = T.lexeme lexer
 --natural       = T.natural lexer
---parens        = T.parens lexer
+parens        = T.parens lexer
 reserved      = T.reserved lexer
 --semi          = T.semi lexer
 --semiSep       = T.semiSep lexer

nginx-lint.cabal

@@ -37,12 +37,11 @@ test-suite nginx-lint-test
   main-is:           Main.hs
   -- TODO: bisect compatible versions
   build-depends:     base (>= 4 && < 5),
-                     HUnit,
                      parsec,
                      QuickCheck,
                      test-framework,
-                     test-framework-hunit,
                      test-framework-quickcheck2,
+                     transformers,
                      uniplate
   other-modules:     NginxLint.Data, NginxLint.Parse
 

test.conf

@@ -1,20 +1,41 @@
 # Normal string.
-error_log /var/log/nginx/error.log info;
+error_log error.log info;
 
 # Quoting is not needed.
-error_log "/var/log/nginx/quoted.log" info;
+error_log "quoted.log" info;
 
-
-# Regex is not needed.
-location ~ ^/foo {
-    root /excessive/regex;
+events {
 }
 
-# Regex may be not needed (if user didn't want case insensitive matching)
-location ~* ^/foo {
-    root /maybe/excessive/regex;
+daemon off;
+pid nginx-test.pid;
+
+http {
+	client_body_temp_path nginx-test;
+	fastcgi_temp_path nginx-test;
+	uwsgi_temp_path nginx-test;
+	scgi_temp_path nginx-test;
+	access_log off;
+
+	server {
+		# Regex is not needed.
+		location ~ ^/foo {
+			root /excessive/regex;
+		}
+
+		# Regex may be not needed (if user didn't want case insensitive matching)
+		location ~* ^/foo {
+			root /maybe/excessive/regex;
+		}
+
+		if (!-f $request_filename) {
+			set $v1 (0ov;
+			rewrite ^/(.*).(gif|jpg|png)$ /$1_2x.$2;
+		}
+	}
 }
 
-if (!-f $request_filename) {
-    root /dont/use/if;
+charset_map  koi8-r  utf-8 {
+
+    80  E282AC ; # euro
 }

test/Main.hs

@@ -1,57 +1,168 @@
 module Main (main) where
 
-import Data.List (isInfixOf)
-import qualified Test.Framework as T
-import Test.Framework.Providers.HUnit (testCase)
+import Data.Monoid (mempty)
+import Debug.Trace
+import Test.Framework.Options (TestOptions, TestOptions'(..))
 import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Framework.Runners.Options (RunnerOptions, RunnerOptions'(..))
+import qualified Test.Framework as T
 import qualified Test.QuickCheck as Q
-import qualified Text.ParserCombinators.Parsec as P
+import qualified Test.QuickCheck.Property as QP
+import qualified Text.Parsec
 
-import NginxLint.Parse (argument, parseFile)
+import qualified NginxLint.Parse
 
 
 main :: IO ()
-main = T.defaultMain tests
-
-tests =
-    [
-    T.testGroup "Cases" $ zipWith (testCase . ("Case "++) . show) [1::Int ..] [
-    ],
-    T.testGroup "Properties" $ zipWith (testProperty . ("Property "++) . show) [1::Int ..] [
-        prop_ParseComment01
-        , prop_ParseArg01
-    ]
-    ]
+main = do
+    let empty_test_opts = mempty :: TestOptions
+    let my_test_opts = empty_test_opts {
+        topt_maximum_generated_tests = Just 2000
+        , topt_maximum_unsuitable_generated_tests = Just 10000
+        , topt_maximum_test_size = Just 500
+    }
+    let empty_runner_opts = mempty :: RunnerOptions
+    let my_runner_opts = empty_runner_opts {
+        ropt_test_options = Just my_test_opts
+        , ropt_color_mode = Just T.ColorAuto
+    }
+    T.defaultMainWithOpts tests my_runner_opts
+    where
+        tests = [
+            T.testGroup "Parser" $ [
+                testProperty "comment-01" $ Q.forAll genComment checkFile
+                , testProperty "arg-01" $ Q.forAll genArg checkArg
+                , testProperty "decl-01" $ Q.forAll genRewrite checkDecl
+                , testProperty "block-01" $ Q.forAll genBlock checkDecl
+            ]
+            ]
 
+genArg :: Q.Gen String
+genArg = Q.oneof [genPlainString]
+
+genBlock :: Q.Gen String
+genBlock = do
+    name <- Q.oneof [return "events", return "http", return "server", genIdentifier]
+    args <- Q.resize 3 $ Q.listOf genArg
+    decls <- Q.resize 5 $ Q.listOf genDecl
+    return $ name ++ " " ++ unwords args ++ " {" ++ concat decls ++ "}"
 
 genComment :: Q.Gen String
 genComment = do
-    s <- Q.arbitrary `Q.suchThat` notElem '\n'
+    s <- Q.listOf $ Q.arbitrary `Q.suchThat` (/= '\n')
     return $ "#" ++ s
 
-genPlainString :: Q.Gen String
-genPlainString = Q.listOf1 c
-    where
-        c = Q.elements (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "~!@#$%^&*")
+genDecl :: Q.Gen String
+genDecl = Q.frequency [
+    (1, genBlock)
+    , (2, genDeclIf)
+    , (10, genDeclSimple)
+    ]
 
-genArg :: Q.Gen String
-genArg = Q.oneof [genPlainString]
+genDeclIf :: Q.Gen String
+genDeclIf = do
+    args <- Q.resize 3 $ Q.listOf1 genArg
+    decls <- Q.resize 5 $ Q.listOf genDeclSimple
+    return $ "if (" ++ unwords args ++ ") {" ++ concat decls ++ "}"
 
-prop_ParseComment01 = Q.forAll genComment isValidConfig
+genDeclSimple :: Q.Gen String
+genDeclSimple = do
+    name <- genIdentifier
+    args <- Q.resize 3 $ Q.listOf genArg
+    return $ name ++ " " ++ unwords args ++ ";"
 
-prop_ParseArg01 = Q.forAll genArg isValidArg
+genIdentifier :: Q.Gen String
+genIdentifier = Q.resize 20 $ Q.listOf1 $ Q.elements identChars
 
+genPlainString :: Q.Gen String
+genPlainString = Q.listOf1 $ Q.elements plainStringChars
+
+genRegex :: Q.Gen String
+genRegex = do
+    prefix <- genFreqMaybe 2 begin
+    suffix <- genFreqMaybe 2 end
+    middle <- fmap concat $ Q.resize 10 $ Q.listOf genoptions
+    return $ prefix ++ middle ++ suffix
+    where
+        genoptions = Q.frequency [
+            (1, group)
+            , (3, klass)
+            , (5, raw0)
+            ]
+        klass = do
+            m <- fmap concat $ Q.resize 5 $ Q.listOf1 klassoptions
+            flag <- genFreqMaybe 3 begin
+            return $ "[" ++ flag ++ m ++ "]"
+        klassoptions = Q.frequency [
+            (3, raw1)
+            , (1, return "a-z")
+            , (1, return "0-9")
+            ]
+        group = do
+            flag <- genFreqMaybe 1 (return "?:")
+            m <- fmap concat $ Q.resize 5 $ Q.listOf1 groupgenoptions
+            q <- genquant
+            return $ "(" ++ flag ++ m ++ ")" ++ q
+        groupgenoptions = Q.frequency [
+            (1, return "|")
+            , (1, genEmpty)
+            , (1, begin)
+            , (1, end)
+            , (2, group)
+            , (3, klass)
+            , (10, raw1)
+            ]
+        genquant = Q.frequency [
+            (10, genEmpty)
+            , (1, return "?")
+            , (1, return "*")
+            ]
+        begin = return "^"
+        end = return "$"
+        raw0 = Q.resize 10 $ Q.listOf genchar
+        raw1 = Q.resize 10 $ Q.listOf1 genchar
+        genchar = Q.elements $ letterChars ++ digitChars ++ "~!@%&."
+
+genRewrite :: Q.Gen String
+genRewrite = do
+    rule <- genRegex
+    target <- gtarget
+    flag <- gflag
+    return $ concat ["rewrite ", rule, " ", target, flag, ";"]
+    where
+        gtarget = Q.elements ["/", "/$1_2x.$2", "http://example$request_uri?"]
+        gflag = Q.elements ["", " break", " last", " permanent"]
 
 -- Begin utils
 
-isRight :: Either a b -> Bool
-isRight (Right _) = True
-isRight _ = False
-
-isValidConfig :: String -> Bool
-isValidConfig s = isRight $ P.parse parseFile "" s
-
-isValidArg :: String -> Bool
-isValidArg s = isRight $ P.parse argument "" s
+genEmpty :: Q.Gen String
+genEmpty = return ""
+
+genFreqMaybe :: Int -> Q.Gen String -> Q.Gen String
+genFreqMaybe n g = Q.frequency [(n, g), (10, genEmpty)]
+
+assertParsed :: Either Text.Parsec.ParseError a -> QP.Result
+assertParsed a = case a of
+    (Right _) -> QP.succeeded
+    (Left e) -> QP.failed { QP.expect = True, QP.reason = show e }
+
+checkFile :: String -> QP.Property
+checkFile = checkParsed NginxLint.Parse.parseFile
+checkArg :: String -> QP.Property
+checkArg = checkParsed NginxLint.Parse.argument
+checkDecl :: String -> QP.Property
+checkDecl = checkParsed NginxLint.Parse.decl
+
+checkParsed :: Text.Parsec.Parsec [a] () a1 -> [a] -> QP.Property
+checkParsed p s = Q.collect (length s) $ Q.within 100000 $ assertParsed $ Text.Parsec.parse p "" s
+
+digitChars :: String
+digitChars = ['0'..'9']
+letterChars :: String
+letterChars = ['A'..'Z'] ++ ['a'..'z']
+identChars :: String
+identChars = letterChars ++ digitChars ++ "_"
+plainStringChars :: String
+plainStringChars = identChars ++ "~!?@%^&*"
 
 -- End utils