diff --git a/src/Property.hs b/src/Property.hs index a6970f73..4e674e99 100644 --- a/src/Property.hs +++ b/src/Property.hs @@ -1,10 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE LambdaCase #-} module Property ( runProperty , PropertyResult (..) #ifdef TEST -, freeVariables +, PropertyType (..) +, propertyType , parseNotInScope #endif ) where @@ -17,6 +19,7 @@ import Util import Interpreter (Interpreter) import qualified Interpreter import Parse +import Runner.Example -- | The result of evaluating an interaction. data PropertyResult = @@ -25,14 +28,38 @@ data PropertyResult = | Error String deriving (Eq, Show) +-- | The type (not in the "type system" sense) of a property +data PropertyType = Simple | QuickCheck [String] | Unknown + deriving (Eq, Show) + runProperty :: Interpreter -> Expression -> IO PropertyResult runProperty repl expression = do + propertyType repl expression >>= \case + Simple -> runSimpleProperty repl expression + QuickCheck vs -> runQuickCheckProperty repl expression vs + Unknown -> runQuickCheckProperty repl expression [] + +-- | Run a property with no free variables (that is, no QuickCheck +-- required). +runSimpleProperty :: Interpreter -> Expression -> IO PropertyResult +runSimpleProperty repl expression = do + r <- fmap lines `fmap` Interpreter.safeEval repl expression + case r of + Left err -> return (Error err) + Right actual -> case mkResult expected actual of + NotEqual err -> return $ Failure (unlines err) + Equal -> return Success + where + expected = [ExpectedLine [LineChunk "True"]] + +-- | Run a property with one or more free variables using QuickCheck. +runQuickCheckProperty :: Interpreter -> Expression -> [String] -> IO PropertyResult +runQuickCheckProperty repl expression vs = do _ <- Interpreter.safeEval repl "import Test.QuickCheck ((==>))" _ <- Interpreter.safeEval repl "import Test.QuickCheck.All (polyQuickCheck)" _ <- Interpreter.safeEval repl "import Language.Haskell.TH (mkName)" _ <- Interpreter.safeEval repl ":set -XTemplateHaskell" - r <- freeVariables repl expression >>= - (Interpreter.safeEval repl . quickCheck expression) + r <- Interpreter.safeEval repl $ quickCheck expression vs case r of Left err -> do return (Error err) @@ -46,13 +73,23 @@ runProperty repl expression = do "let doctest_prop " ++ unwords vars ++ " = " ++ term ++ "\n" ++ "$(polyQuickCheck (mkName \"doctest_prop\"))" --- | Find all free variables in given term. + +-- | Determing what type of property a term corresponds to. +-- +-- GHCi is used to determing the type. -- --- GHCi is used to detect free variables. -freeVariables :: Interpreter -> String -> IO [String] -freeVariables repl term = do +-- If the type is Bool the property is simple and does not need QuickCheck. +-- +-- Otherwise we assume QuickCheck will be needed. If GHCi reported any free +-- variables they are extracted for passing to QuickCheck. +propertyType :: Interpreter -> String -> IO PropertyType +propertyType repl term = do r <- Interpreter.safeEval repl (":type " ++ term) - return (either (const []) (nub . parseNotInScope) r) + case r of + Left _ -> return Unknown + Right s -> if " :: Bool\n" `isSuffixOf` s + then return Simple + else return $ QuickCheck (parseNotInScope s) -- | Parse and return all variables that are not in scope from a ghc error -- message. diff --git a/test/PropertySpec.hs b/test/PropertySpec.hs index 29c934f8..575aed23 100644 --- a/test/PropertySpec.hs +++ b/test/PropertySpec.hs @@ -18,7 +18,10 @@ spec :: Spec spec = do describe "runProperty" $ do it "reports a failing property" $ withInterpreter [] $ \repl -> do - runProperty repl "False" `shouldReturn` Failure "*** Failed! Falsified (after 1 test):" + runProperty repl "const False (x :: Int)" `shouldReturn` Failure "*** Failed! Falsified (after 1 test):\n0" + + it "reports a failing simple property" $ withInterpreter [] $ \repl -> do + runProperty repl "False" `shouldReturn` Failure "expected: True\n but got: False\n" it "runs a Bool property" $ withInterpreter [] $ \repl -> do runProperty repl "True" `shouldReturn` Success @@ -58,21 +61,27 @@ spec = do it "defaults ambiguous type variables to Integer" $ withInterpreter [] $ \repl -> do runProperty repl "reverse xs == xs" >>= (`shouldSatisfy` isFailure) - describe "freeVariables" $ do - it "finds a free variables in a term" $ withInterpreter [] $ \repl -> do - freeVariables repl "x" `shouldReturn` ["x"] + describe "propertyType" $ do + it "finds free variables in a term" $ withInterpreter [] $ \repl -> do + propertyType repl "x" `shouldReturn` QuickCheck ["x"] it "ignores duplicates" $ withInterpreter [] $ \repl -> do - freeVariables repl "x == x" `shouldReturn` ["x"] + propertyType repl "x == x" `shouldReturn` QuickCheck ["x"] it "works for terms with multiple names" $ withInterpreter [] $ \repl -> do - freeVariables repl "\\z -> x + y + z == foo 23" `shouldReturn` ["x", "y", "foo"] + propertyType repl "\\z -> x + y + z == foo 23" `shouldReturn` QuickCheck ["x", "y", "foo"] it "works for names that contain a prime" $ withInterpreter [] $ \repl -> do - freeVariables repl "x' == y''" `shouldReturn` ["x'", "y''"] + propertyType repl "x' == y''" `shouldReturn` QuickCheck ["x'", "y''"] it "works for names that are similar to other names that are in scope" $ withInterpreter [] $ \repl -> do - freeVariables repl "length_" `shouldReturn` ["length_"] + propertyType repl "length_" `shouldReturn` QuickCheck ["length_"] + + it "identifies simple properties without free variables" $ withInterpreter [] $ \repl -> do + propertyType repl "True" `shouldReturn` Simple + + it "identifies QuickCheck properties without free variables" $ withInterpreter [] $ \repl -> do + propertyType repl "Just True" `shouldReturn` QuickCheck [] describe "parseNotInScope" $ do context "when error message was produced by GHC 7.4.1" $ do