From 1b8711d51c291d9c5a60dc8c91670473ea37ec29 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 11 Oct 2019 00:01:34 +0700 Subject: [PATCH 1/6] (#801) Fix Expr parser --- src/Bot/Expr.hs | 6 ++++-- test/Bot/ExprTest.hs | 1 + 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Bot/Expr.hs b/src/Bot/Expr.hs index 034bd1f..e37bd92 100644 --- a/src/Bot/Expr.hs +++ b/src/Bot/Expr.hs @@ -65,14 +65,16 @@ sepBy element sep = do args <- many (sep >> element) return (arg : args) +funcallarg :: Parser Expr +funcallarg = funcall <|> var <|> stringLiteral + funcall :: Parser Expr funcall = do _ <- charP '%' >> whitespaces name <- symbol _ <- whitespaces >> charP '(' >> whitespaces args <- - sepBy (funcall <|> var <|> stringLiteral) (whitespaces >> charP ',') <|> - return [] + sepBy funcallarg (whitespaces >> charP ',' >> whitespaces) <|> return [] _ <- whitespaces >> charP ')' return $ FunCallExpr name args diff --git a/test/Bot/ExprTest.hs b/test/Bot/ExprTest.hs index 4ab75fc..9ba3a06 100644 --- a/test/Bot/ExprTest.hs +++ b/test/Bot/ExprTest.hs @@ -52,6 +52,7 @@ exprsTest = , TextExpr " baz ()" ])) , ("%f(%x)", Right ("", [FunCallExpr "f" [VarExpr "x"]])) + , ("%f(%x, %y)", Right ("", [FunCallExpr "f" [VarExpr "x", VarExpr "y"]])) , ( "\"hello %x world\"" , Right ("", [TextExpr "\"hello ", VarExpr "x", TextExpr " world\""])) ] From de1306825a04553c539d5c779a8849e999ff575d Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 11 Oct 2019 18:21:00 +0700 Subject: [PATCH 2/6] (#801) Add Exprs fuzzer --- HyperNerd.cabal | 19 +++++++ src/Bot/Expr.hs | 6 +- src/FuzzyMain.hs | 140 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 162 insertions(+), 3 deletions(-) create mode 100644 src/FuzzyMain.hs diff --git a/HyperNerd.cabal b/HyperNerd.cabal index f6bec78..8eadac3 100644 --- a/HyperNerd.cabal +++ b/HyperNerd.cabal @@ -151,6 +151,25 @@ executable HyperNerd -- Base language which the package is written in. default-language: Haskell2010 +executable Fuzzy + ghc-options: -threaded + -Wall + -fwarn-incomplete-patterns + -fwarn-incomplete-uni-patterns + + main-is: FuzzyMain.hs + + other-modules: Bot.Expr + + build-depends: base + , text + , random + , aeson + + hs-source-dirs: src + + default-language: Haskell2010 + executable Markov ghc-options: -threaded -Wall diff --git a/src/Bot/Expr.hs b/src/Bot/Expr.hs index e37bd92..573dbde 100644 --- a/src/Bot/Expr.hs +++ b/src/Bot/Expr.hs @@ -7,7 +7,7 @@ import Control.Applicative import Data.Char import qualified Data.Text as T import Data.Tuple -import Effect +-- import Effect data Expr = TextExpr T.Text @@ -121,5 +121,5 @@ exprs :: Parser [Expr] exprs = many expr -- TODO(#600): interpretExprs is not implemented -interpretExprs :: NameTable -> [Expr] -> Effect T.Text -interpretExprs = undefined +-- interpretExprs :: NameTable -> [Expr] -> Effect T.Text +-- interpretExprs = undefined diff --git a/src/FuzzyMain.hs b/src/FuzzyMain.hs new file mode 100644 index 0000000..a9fb3d9 --- /dev/null +++ b/src/FuzzyMain.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import qualified Data.Text as T +import Bot.Expr +import System.Random +import Control.Monad +import Data.Char +import Data.List +import Data.Aeson.Types +import Data.Aeson +import System.Environment +import Text.Printf + +data FuzzParams = FuzzParams + { fpFuzzCount :: Int + , fpExprsRange :: (Int, Int) + , fpFunCallArgsRange :: (Int, Int) + , fpWordLenRange :: (Int, Int) + , fpTextWordCountRange :: (Int, Int) + } deriving (Show, Eq) + +instance ToJSON FuzzParams where + toJSON params = + object + [ "FuzzCount" .= fpFuzzCount params + , "ExprsRange" .= fpExprsRange params + , "FunCallArgsRange" .= fpFunCallArgsRange params + , "WordLenRange" .= fpWordLenRange params + , "TextWordCountRange" .= fpTextWordCountRange params + ] + +instance FromJSON FuzzParams where + parseJSON (Object params) = + FuzzParams <$> params .: "FuzzCount" <*> params .: "ExprsRange" <*> + params .: "FunCallArgsRange" <*> + params .: "WordLenRange" <*> + params .: "TextWordCountRange" + parseJSON invalid = typeMismatch "FuzzParams" invalid + +readFuzzParams :: FilePath -> IO FuzzParams +readFuzzParams = fmap (either error id) . eitherDecodeFileStrict + +defaultFuzzParams :: FuzzParams +defaultFuzzParams = + FuzzParams + { fpFuzzCount = 100 + , fpExprsRange = (1, 100) + , fpFunCallArgsRange = (0, 2) + , fpWordLenRange = (2, 10) + , fpTextWordCountRange = (3, 5) + } + +unparseFunCallArg :: Expr -> T.Text +unparseFunCallArg (TextExpr text) = "\"" <> text <> "\"" +unparseFunCallArg e = unparseExpr e + +unparseFunCallArgs :: [Expr] -> T.Text +unparseFunCallArgs = T.concat . intersperse "," . map unparseFunCallArg + +unparseExpr :: Expr -> T.Text +unparseExpr (TextExpr text) = text +unparseExpr (VarExpr name) = "%" <> name +unparseExpr (FunCallExpr name args) = + "%" <> name <> "(" <> unparseFunCallArgs args <> ")" + +unparseExprs :: [Expr] -> T.Text +unparseExprs = T.concat . map unparseExpr + +randomChar :: IO Char +randomChar = do + x <- randomRIO (0, ord 'z' - ord 'a') + return $ chr (x + ord 'a') + +randomText :: FuzzParams -> IO T.Text +randomText params = do + n <- randomRIO $ fpTextWordCountRange params + T.concat . intersperse " " <$> replicateM n (randomWord params) + +randomWord :: FuzzParams -> IO T.Text +randomWord params = do + n <- randomRIO $ fpWordLenRange params + T.pack <$> replicateM n randomChar + +randomTextExpr :: FuzzParams -> IO Expr +randomTextExpr params = TextExpr <$> randomText params + +randomVarExpr :: FuzzParams -> IO Expr +randomVarExpr params = VarExpr <$> randomWord params + +randomFunCallExpr :: FuzzParams -> IO Expr +randomFunCallExpr params = do + name <- randomWord params + n <- randomRIO $ fpFunCallArgsRange params + args <- replicateM n (randomExpr params) + return $ FunCallExpr name args + +randomExpr :: FuzzParams -> IO Expr +randomExpr params = do + n <- (randomRIO (0, 2) :: IO Int) + case n of + 0 -> randomTextExpr params + 1 -> randomVarExpr params + _ -> randomFunCallExpr params + +normalizeExprs :: [Expr] -> [Expr] +normalizeExprs [] = [] +normalizeExprs (TextExpr t1:TextExpr t2:rest) = + normalizeExprs (TextExpr (t1 <> t2):rest) +normalizeExprs (_:rest) = normalizeExprs rest + +randomExprs :: FuzzParams -> IO [Expr] +randomExprs params = do + n <- randomRIO $ fpExprsRange params + replicateM n (randomExpr params) + +fuzzIteration :: FuzzParams -> IO Bool +fuzzIteration params = do + es <- normalizeExprs <$> randomExprs params + let es' = runParser exprs $ unparseExprs es + when ((Right ("", es)) /= es') $ do + print es + print es' + error "test" + return ((Right ("", es)) == es') + +fuzz :: FuzzParams -> IO () +fuzz params = do + report <- replicateM (fpFuzzCount params) (fuzzIteration params) + printf "Failures: %d\n" $ length $ filter (not . id) report + printf "Successes: %d\n" $ length $ filter id report + +mainWithArgs :: [String] -> IO () +mainWithArgs (fuzzParamsPath:_) = do + readFuzzParams fuzzParamsPath >>= fuzz +mainWithArgs _ = error "Usage: Fuzz " + +main :: IO () +main = getArgs >>= mainWithArgs From 7fca4bf249b14521e32933363382d1d75c50cde3 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 11 Oct 2019 18:34:08 +0700 Subject: [PATCH 3/6] (#801) Fix hlint remarks --- src/FuzzyMain.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/FuzzyMain.hs b/src/FuzzyMain.hs index a9fb3d9..f30948e 100644 --- a/src/FuzzyMain.hs +++ b/src/FuzzyMain.hs @@ -98,7 +98,7 @@ randomFunCallExpr params = do randomExpr :: FuzzParams -> IO Expr randomExpr params = do - n <- (randomRIO (0, 2) :: IO Int) + n <- randomRIO (0, 2) :: IO Int case n of 0 -> randomTextExpr params 1 -> randomVarExpr params @@ -119,21 +119,20 @@ fuzzIteration :: FuzzParams -> IO Bool fuzzIteration params = do es <- normalizeExprs <$> randomExprs params let es' = runParser exprs $ unparseExprs es - when ((Right ("", es)) /= es') $ do + when (Right ("", es)) /= es' $ do print es print es' error "test" - return ((Right ("", es)) == es') + return (Right ("", es)) == es' fuzz :: FuzzParams -> IO () fuzz params = do report <- replicateM (fpFuzzCount params) (fuzzIteration params) - printf "Failures: %d\n" $ length $ filter (not . id) report + printf "Failures: %d\n" $ length $ filter not report printf "Successes: %d\n" $ length $ filter id report mainWithArgs :: [String] -> IO () -mainWithArgs (fuzzParamsPath:_) = do - readFuzzParams fuzzParamsPath >>= fuzz +mainWithArgs (fuzzParamsPath:_) = readFuzzParams fuzzParamsPath >>= fuzz mainWithArgs _ = error "Usage: Fuzz " main :: IO () From 5ef11936ca80d1f6eb38f9710d64462002306d40 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 11 Oct 2019 18:34:51 +0700 Subject: [PATCH 4/6] (#801) Fix hindent remarks --- src/Bot/Expr.hs | 3 +-- src/FuzzyMain.hs | 10 +++++----- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/Bot/Expr.hs b/src/Bot/Expr.hs index 573dbde..d745c03 100644 --- a/src/Bot/Expr.hs +++ b/src/Bot/Expr.hs @@ -7,8 +7,8 @@ import Control.Applicative import Data.Char import qualified Data.Text as T import Data.Tuple --- import Effect +-- import Effect data Expr = TextExpr T.Text | FunCallExpr T.Text @@ -119,7 +119,6 @@ expr = funcall <|> var <|> textBlock exprs :: Parser [Expr] exprs = many expr - -- TODO(#600): interpretExprs is not implemented -- interpretExprs :: NameTable -> [Expr] -> Effect T.Text -- interpretExprs = undefined diff --git a/src/FuzzyMain.hs b/src/FuzzyMain.hs index f30948e..41b7668 100644 --- a/src/FuzzyMain.hs +++ b/src/FuzzyMain.hs @@ -2,15 +2,15 @@ module Main where -import qualified Data.Text as T import Bot.Expr -import System.Random import Control.Monad +import Data.Aeson +import Data.Aeson.Types import Data.Char import Data.List -import Data.Aeson.Types -import Data.Aeson +import qualified Data.Text as T import System.Environment +import System.Random import Text.Printf data FuzzParams = FuzzParams @@ -107,7 +107,7 @@ randomExpr params = do normalizeExprs :: [Expr] -> [Expr] normalizeExprs [] = [] normalizeExprs (TextExpr t1:TextExpr t2:rest) = - normalizeExprs (TextExpr (t1 <> t2):rest) + normalizeExprs (TextExpr (t1 <> t2) : rest) normalizeExprs (_:rest) = normalizeExprs rest randomExprs :: FuzzParams -> IO [Expr] From 769d8cfd282bb5b6e73671820e987034475eb66f Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 11 Oct 2019 18:38:06 +0700 Subject: [PATCH 5/6] (#801) Remove dead comments --- src/Bot/Expr.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Bot/Expr.hs b/src/Bot/Expr.hs index d745c03..6f8f0bb 100644 --- a/src/Bot/Expr.hs +++ b/src/Bot/Expr.hs @@ -8,7 +8,6 @@ import Data.Char import qualified Data.Text as T import Data.Tuple --- import Effect data Expr = TextExpr T.Text | FunCallExpr T.Text From fee3413ebcd4e0a9fb8bee8fd6c6cb3a37b48660 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 11 Oct 2019 18:52:12 +0700 Subject: [PATCH 6/6] (#801) Fix compilation error --- src/FuzzyMain.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/FuzzyMain.hs b/src/FuzzyMain.hs index 41b7668..e12bf4a 100644 --- a/src/FuzzyMain.hs +++ b/src/FuzzyMain.hs @@ -119,11 +119,11 @@ fuzzIteration :: FuzzParams -> IO Bool fuzzIteration params = do es <- normalizeExprs <$> randomExprs params let es' = runParser exprs $ unparseExprs es - when (Right ("", es)) /= es' $ do + when (Right ("", es) /= es') $ do print es print es' error "test" - return (Right ("", es)) == es' + return (Right ("", es) == es') fuzz :: FuzzParams -> IO () fuzz params = do