module Property (
runProperty
, PropertyResult (..)
#ifdef TEST
, freeVariables
, parseNotInScope
#endif
) where
import Data.List
import Util
import Interpreter (Interpreter)
import qualified Interpreter
import Parse
data PropertyResult =
Success
| Failure String
| Error String
deriving (Eq, Show)
runProperty :: Interpreter -> Expression -> IO PropertyResult
runProperty repl expression = do
_ <- Interpreter.eval repl "import Test.QuickCheck (quickCheck, (==>))"
r <- closeTerm expression >>= (Interpreter.safeEval repl . quickCheck)
case r of
Left err -> do
return (Error err)
Right res
| "OK, passed" `isInfixOf` res -> return Success
| otherwise -> do
let msg = stripEnd (takeWhileEnd (/= '\b') res)
return (Failure msg)
where
quickCheck term = "quickCheck (" ++ term ++ ")"
closeTerm :: String -> IO String
closeTerm term = do
r <- freeVariables repl (quickCheck term)
case r of
[] -> return term
vars -> return ("\\" ++ unwords vars ++ "-> (" ++ term ++ ")")
freeVariables :: Interpreter -> String -> IO [String]
freeVariables repl term = do
r <- Interpreter.safeEval repl (":type " ++ term)
return (either (const []) (nub . parseNotInScope) r)
parseNotInScope :: String -> [String]
parseNotInScope = nub . map extractVariable . filter ("Not in scope: " `isInfixOf`) . lines
where
extractVariable :: String -> String
extractVariable = unquote . takeWhileEnd (/= ' ')
unquote ('`':xs) = init xs
unquote xs = xs