{-# 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

-- | The result of evaluating an interaction.
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\"))"

-- | Find all free variables in given term.
--
-- GHCi is used to detect free variables.
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)

-- | Parse and return all variables that are not in scope from a ghc error
-- message.
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
    -- | Extract variable name from a "Not in scope"-error.
    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

    -- | Remove quotes from given name, if any.
    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