    {-# LANGUAGE CPP #-}
    {-# LANGUAGE PatternGuards #-}
    module Property (
      runProperty
    , PropertyResult (..)
    #ifdef TEST
    , freeVariables
    , parseNotInScope
    #endif
    ) where

    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
    (PropertyResult -> PropertyResult -> Bool)
    -> (PropertyResult -> PropertyResult -> Bool) -> Eq PropertyResult
    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
    (Int -> PropertyResult -> ShowS)
    -> (PropertyResult -> String)
    -> ([PropertyResult] -> ShowS)
    -> Show PropertyResult
    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 repl :: Interpreter
    repl expression :: String
    expression = do
      Either String String
    _ <- Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl "import Test.QuickCheck ((==>))"
      Either String String
    _ <- Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl "import Test.QuickCheck.All (polyQuickCheck)"
      Either String String
    _ <- Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl "import Language.Haskell.TH (mkName)"
      Either String String
    _ <- Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl ":set -XTemplateHaskell"
      Either String String
    r <- Interpreter -> String -> IO [String]
    freeVariables Interpreter
    repl String
    expression IO [String]
    -> ([String] -> IO (Either String String))
    -> IO (Either String String)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
           (Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl (String -> IO (Either String String))
    -> ([String] -> String) -> [String] -> IO (Either String String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String] -> String
    quickCheck String
    expression)
      case Either String String
    r of
        Left err :: String
    err -> do
          PropertyResult -> IO PropertyResult
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> PropertyResult
    Error String
    err)
        Right res :: String
    res
          | "OK, passed" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    res -> PropertyResult -> IO PropertyResult
    forall (m :: * -> *) a. Monad m => a -> m a
    return PropertyResult
    Success
          | Bool
    otherwise -> do
              let msg :: String
    msg =  ShowS
    stripEnd ((Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhileEnd (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '\b') String
    res)
              PropertyResult -> IO PropertyResult
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> PropertyResult
    Failure String
    msg)
      where
        quickCheck :: String -> [String] -> String
    quickCheck term :: String
    term vars :: [String]
    vars =
          "let doctest_prop " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [String]
    vars String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    term String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
          "$(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 repl :: Interpreter
    repl term :: String
    term = do
      Either String String
    r <- Interpreter -> String -> IO (Either String String)
    Interpreter.safeEval Interpreter
    repl (":type " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    term)
      [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((String -> [String])
    -> (String -> [String]) -> Either String String -> [String]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([String] -> String -> [String]
    forall a b. a -> b -> a
    const []) ([String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    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 = [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Maybe String) -> [String] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe String -> Maybe String
    extractVariable ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    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 x :: String
    x
          | "Not in scope: " String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    x = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> ShowS -> String -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    unquote ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhileEnd (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ' ') (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String
    x
          | Just y :: String
    y <- ([Maybe String] -> Maybe String
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    asum ([Maybe String] -> Maybe String) -> [Maybe String] -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ (String -> Maybe String) -> [String] -> [Maybe String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix "Variable not in scope: ") (String -> [String]
    forall a. [a] -> [[a]]
    tails String
    x)) = String -> Maybe String
    forall a. a -> Maybe a
    Just ((Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ' ') String
    y)
          | Bool
    otherwise = Maybe String
    forall a. Maybe a
    Nothing

        -- | Remove quotes from given name, if any.
        unquote :: ShowS
    unquote ('`':xs :: String
    xs)     = ShowS
    forall a. [a] -> [a]
    init String
    xs
    #if __GLASGOW_HASKELL__ >= 707
        unquote ('\8216':xs :: String
    xs) = ShowS
    forall a. [a] -> [a]
    init String
    xs
    #endif
        unquote xs :: String
    xs           = String
    xs