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.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)
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 vars =
"let doctest_prop " ++ unwords vars ++ " = " ++ term ++ "\n" ++
"$(polyQuickCheck (mkName \"doctest_prop\"))"
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
#if __GLASGOW_HASKELL__ >= 707
unquote ('\8216':xs) = init xs
#endif
unquote xs = xs