{-# LANGUAGE CPP #-}
module Property (
runProperty
, PropertyResult (..)
#ifdef TEST
, freeVariables
, parseNotInScope
#endif
) where
import Imports
import Data.List
import Data.Maybe
import Data.Foldable
import Util
import Interpreter (Interpreter)
import qualified Interpreter
import Parse
data PropertyResult =
Success
| Failure String
| Error String
deriving (PropertyResult -> PropertyResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyResult -> PropertyResult -> Bool
$c/= :: PropertyResult -> PropertyResult -> Bool
== :: PropertyResult -> PropertyResult -> Bool
$c== :: PropertyResult -> PropertyResult -> Bool
Eq, Int -> PropertyResult -> ShowS
[PropertyResult] -> ShowS
PropertyResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyResult] -> ShowS
$cshowList :: [PropertyResult] -> ShowS
show :: PropertyResult -> String
$cshow :: PropertyResult -> String
showsPrec :: Int -> PropertyResult -> ShowS
$cshowsPrec :: Int -> PropertyResult -> ShowS
Show)
runProperty :: Interpreter -> Expression -> IO PropertyResult
runProperty :: Interpreter -> String -> IO PropertyResult
runProperty Interpreter
repl String
expression = do
Either String String
_ <- Interpreter -> String -> IO (Either String String)
Interpreter.safeEval Interpreter
repl String
"import Test.QuickCheck ((==>))"
Either String String
_ <- Interpreter -> String -> IO (Either String String)
Interpreter.safeEval Interpreter
repl String
"import Test.QuickCheck.All (polyQuickCheck)"
Either String String
_ <- Interpreter -> String -> IO (Either String String)
Interpreter.safeEval Interpreter
repl String
"import Language.Haskell.TH (mkName)"
Either String String
r <- Interpreter -> String -> IO [String]
freeVariables Interpreter
repl String
expression forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Interpreter -> String -> IO (Either String String)
Interpreter.safeEval Interpreter
repl forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
quickCheck String
expression)
case Either String String
r of
Left String
err -> do
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PropertyResult
Error String
err)
Right String
res
| String
"OK, passed" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
res -> forall (m :: * -> *) a. Monad m => a -> m a
return PropertyResult
Success
| Bool
otherwise -> do
let msg :: String
msg = ShowS
stripEnd (forall a. (a -> Bool) -> [a] -> [a]
takeWhileEnd (forall a. Eq a => a -> a -> Bool
/= Char
'\b') String
res)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PropertyResult
Failure String
msg)
where
quickCheck :: String -> [String] -> String
quickCheck String
term [String]
vars =
String
"let doctest_prop " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
vars forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ String
term forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
String
"$(polyQuickCheck (mkName \"doctest_prop\"))"
freeVariables :: Interpreter -> String -> IO [String]
freeVariables :: Interpreter -> String -> IO [String]
freeVariables Interpreter
repl String
term = do
Either String String
r <- Interpreter -> String -> IO (Either String String)
Interpreter.safeEval Interpreter
repl (String
":type " forall a. [a] -> [a] -> [a]
++ String
term)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) (forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
parseNotInScope) Either String String
r)
parseNotInScope :: String -> [String]
parseNotInScope :: String -> [String]
parseNotInScope = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
extractVariable forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
where
extractVariable :: String -> Maybe String
extractVariable :: String -> Maybe String
extractVariable String
x
| String
"Not in scope: " forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
x = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unquote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhileEnd (forall a. Eq a => a -> a -> Bool
/= Char
' ') forall a b. (a -> b) -> a -> b
$ String
x
| Just String
y <- (forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"Variable not in scope: ") (forall a. [a] -> [[a]]
tails String
x)) = forall a. a -> Maybe a
Just (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
' ') String
y)
| Bool
otherwise = forall a. Maybe a
Nothing
unquote :: ShowS
unquote (Char
'`':String
xs) = forall a. [a] -> [a]
init String
xs
unquote (Char
'\8216':String
xs) = forall a. [a] -> [a]
init String
xs
unquote String
xs = String
xs