{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module Runner (
  runModules
, Verbose(..)
, Summary(..)
, formatSummary

#ifdef TEST
, Report
, ReportState(..)
, Interactive(..)
, report
, reportTransient
#endif
) where

import           Prelude ()
import           Imports hiding (putStr, putStrLn, error)

import           Text.Printf (printf)
import           System.IO hiding (putStr, putStrLn)

import           Control.Monad.Trans.State
import           Control.Monad.IO.Class
import           Data.IORef

import           Interpreter (Interpreter)
import qualified Interpreter
import           Parse
import           Location
import           Property
import           Runner.Example

-- | Summary of a test run.
data Summary = Summary {
  Summary -> Int
sExamples :: !Int
, Summary -> Int
sTried    :: !Int
, Summary -> Int
sErrors   :: !Int
, Summary -> Int
sFailures :: !Int
} deriving Summary -> Summary -> Bool
(Summary -> Summary -> Bool)
-> (Summary -> Summary -> Bool) -> Eq Summary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Summary -> Summary -> Bool
== :: Summary -> Summary -> Bool
$c/= :: Summary -> Summary -> Bool
/= :: Summary -> Summary -> Bool
Eq

instance Show Summary where
  show :: Summary -> String
show = Summary -> String
formatSummary

formatSummary :: Summary -> String
formatSummary :: Summary -> String
formatSummary (Summary Int
examples Int
tried Int
errors Int
failures) =
  String -> Int -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Examples: %d  Tried: %d  Errors: %d  Failures: %d" Int
examples Int
tried Int
errors Int
failures

-- | Sum up summaries.
instance Monoid Summary where
  mempty :: Summary
mempty = Int -> Int -> Int -> Int -> Summary
Summary Int
0 Int
0 Int
0 Int
0
#if __GLASGOW_HASKELL__ < 804
  mappend
#else
instance Semigroup Summary where
  <> :: Summary -> Summary -> Summary
(<>)
#endif
    (Summary Int
x1 Int
x2 Int
x3 Int
x4) (Summary Int
y1 Int
y2 Int
y3 Int
y4) = Int -> Int -> Int -> Int -> Summary
Summary (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y1) (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y2) (Int
x3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y3) (Int
x4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y4)

withLineBuffering :: Handle -> IO c -> IO c
withLineBuffering :: forall c. Handle -> IO c -> IO c
withLineBuffering Handle
h IO c
action = IO BufferMode
-> (BufferMode -> IO ()) -> (BufferMode -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Handle -> IO BufferMode
hGetBuffering Handle
h) (Handle -> BufferMode -> IO ()
hSetBuffering Handle
h) ((BufferMode -> IO c) -> IO c) -> (BufferMode -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \ BufferMode
_ -> do
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
  IO c
action

-- | Run all examples from a list of modules.
runModules :: Bool -> Bool -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary
runModules :: Bool
-> Bool
-> Verbose
-> Interpreter
-> [Module [Located DocTest]]
-> IO Summary
runModules Bool
fastMode Bool
preserveIt Verbose
verbose Interpreter
repl [Module [Located DocTest]]
modules = Handle -> IO Summary -> IO Summary
forall c. Handle -> IO c -> IO c
withLineBuffering Handle
stderr (IO Summary -> IO Summary) -> IO Summary -> IO Summary
forall a b. (a -> b) -> a -> b
$ do

  Interactive
interactive <- Handle -> IO Bool
hIsTerminalDevice Handle
stderr IO Bool -> (Bool -> Interactive) -> IO Interactive
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ case
    Bool
False -> Interactive
NonInteractive
    Bool
True -> Interactive
Interactive

  IORef Summary
summary <- Summary -> IO (IORef Summary)
forall a. a -> IO (IORef a)
newIORef Summary
forall a. Monoid a => a
mempty {sExamples = n}

  let
    reportFinalResult :: IO ()
    reportFinalResult :: IO ()
reportFinalResult = do
      Summary
final <- IORef Summary -> IO Summary
forall a. IORef a -> IO a
readIORef IORef Summary
summary
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (Summary -> String
formatSummary Summary
final)

    run :: IO ()
    run :: IO ()
run = (StateT ReportState IO () -> ReportState -> IO ())
-> ReportState -> StateT ReportState IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ReportState IO () -> ReportState -> IO ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Interactive -> Verbose -> IORef Summary -> ReportState
ReportState Interactive
interactive Verbose
verbose IORef Summary
summary) (StateT ReportState IO () -> IO ())
-> StateT ReportState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      StateT ReportState IO ()
reportProgress
      [Module [Located DocTest]]
-> (Module [Located DocTest] -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Module [Located DocTest]]
modules ((Module [Located DocTest] -> StateT ReportState IO ())
 -> StateT ReportState IO ())
-> (Module [Located DocTest] -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Interpreter
-> Module [Located DocTest]
-> StateT ReportState IO ()
runModule Bool
fastMode Bool
preserveIt Interpreter
repl
      String -> StateT ReportState IO ()
verboseReport String
"# Final summary:"

  IO ()
run IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` IO ()
reportFinalResult

  IORef Summary -> IO Summary
forall a. IORef a -> IO a
readIORef IORef Summary
summary
  where
    n :: Int
    n :: Int
n = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Module [Located DocTest] -> Int)
-> [Module [Located DocTest]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Module [Located DocTest] -> Int
countExpressions [Module [Located DocTest]]
modules)

countExpressions :: Module [Located DocTest] -> Int
countExpressions :: Module [Located DocTest] -> Int
countExpressions (Module String
_ Maybe [Located DocTest]
setup [[Located DocTest]]
tests) = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Located DocTest] -> Int) -> [[Located DocTest]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Located DocTest] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Located DocTest]]
tests) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> ([Located DocTest] -> Int) -> Maybe [Located DocTest] -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 [Located DocTest] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe [Located DocTest]
setup

type Report = StateT ReportState IO

data Interactive = NonInteractive | Interactive

data Verbose = NonVerbose | Verbose
  deriving (Verbose -> Verbose -> Bool
(Verbose -> Verbose -> Bool)
-> (Verbose -> Verbose -> Bool) -> Eq Verbose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbose -> Verbose -> Bool
== :: Verbose -> Verbose -> Bool
$c/= :: Verbose -> Verbose -> Bool
/= :: Verbose -> Verbose -> Bool
Eq, Int -> Verbose -> String -> String
[Verbose] -> String -> String
Verbose -> String
(Int -> Verbose -> String -> String)
-> (Verbose -> String)
-> ([Verbose] -> String -> String)
-> Show Verbose
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Verbose -> String -> String
showsPrec :: Int -> Verbose -> String -> String
$cshow :: Verbose -> String
show :: Verbose -> String
$cshowList :: [Verbose] -> String -> String
showList :: [Verbose] -> String -> String
Show)

data ReportState = ReportState {
  ReportState -> Interactive
reportStateInteractive :: Interactive
, ReportState -> Verbose
reportStateVerbose :: Verbose
, ReportState -> IORef Summary
reportStateSummary :: IORef Summary
}

getSummary :: Report Summary
getSummary :: Report Summary
getSummary = (ReportState -> IORef Summary)
-> StateT ReportState IO (IORef Summary)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ReportState -> IORef Summary
reportStateSummary StateT ReportState IO (IORef Summary)
-> (IORef Summary -> Report Summary) -> Report Summary
forall a b.
StateT ReportState IO a
-> (a -> StateT ReportState IO b) -> StateT ReportState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Summary -> Report Summary
forall a. IO a -> StateT ReportState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Summary -> Report Summary)
-> (IORef Summary -> IO Summary) -> IORef Summary -> Report Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Summary -> IO Summary
forall a. IORef a -> IO a
readIORef

-- | Add output to the report.
report :: String -> Report ()
report :: String -> StateT ReportState IO ()
report = IO () -> StateT ReportState IO ()
forall a. IO a -> StateT ReportState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT ReportState IO ())
-> (String -> IO ()) -> String -> StateT ReportState IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr

-- | Add intermediate output to the report.
--
-- This will be overwritten by subsequent calls to `report`/`report_`.
-- Intermediate out may not contain any newlines.
reportTransient :: String -> Report ()
reportTransient :: String -> StateT ReportState IO ()
reportTransient String
msg = (ReportState -> Interactive) -> StateT ReportState IO Interactive
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ReportState -> Interactive
reportStateInteractive StateT ReportState IO Interactive
-> (Interactive -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall a b.
StateT ReportState IO a
-> (a -> StateT ReportState IO b) -> StateT ReportState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
  Interactive
NonInteractive -> StateT ReportState IO ()
forall (m :: * -> *). Monad m => m ()
pass
  Interactive
Interactive -> IO () -> StateT ReportState IO ()
forall a. IO a -> StateT ReportState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT ReportState IO ())
-> IO () -> StateT ReportState IO ()
forall a b. (a -> b) -> a -> b
$ do
    Handle -> String -> IO ()
hPutStr Handle
stderr String
msg
    Handle -> IO ()
hFlush Handle
stderr
    Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Char
'\r' Char -> String -> String
forall a. a -> [a] -> [a]
: (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
msg) Char
' ') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\r"

-- | Run all examples from given module.
runModule :: Bool -> Bool -> Interpreter -> Module [Located DocTest] -> Report ()
runModule :: Bool
-> Bool
-> Interpreter
-> Module [Located DocTest]
-> StateT ReportState IO ()
runModule Bool
fastMode Bool
preserveIt Interpreter
repl (Module String
module_ Maybe [Located DocTest]
setup [[Located DocTest]]
examples) = do

  Summary Int
_ Int
_ Int
e0 Int
f0 <- Report Summary
getSummary

  Maybe [Located DocTest]
-> ([Located DocTest] -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [Located DocTest]
setup (([Located DocTest] -> StateT ReportState IO ())
 -> StateT ReportState IO ())
-> ([Located DocTest] -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall a b. (a -> b) -> a -> b
$
    Bool
-> Interpreter
-> IO ()
-> [Located DocTest]
-> StateT ReportState IO ()
runTestGroup Bool
preserveIt Interpreter
repl IO ()
reload

  Summary Int
_ Int
_ Int
e1 Int
f1 <- Report Summary
getSummary

  -- only run tests, if setup does not produce any errors/failures
  Bool -> StateT ReportState IO () -> StateT ReportState IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
e0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
e1 Bool -> Bool -> Bool
&& Int
f0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
f1) (StateT ReportState IO () -> StateT ReportState IO ())
-> StateT ReportState IO () -> StateT ReportState IO ()
forall a b. (a -> b) -> a -> b
$
    [[Located DocTest]]
-> ([Located DocTest] -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Located DocTest]]
examples (([Located DocTest] -> StateT ReportState IO ())
 -> StateT ReportState IO ())
-> ([Located DocTest] -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall a b. (a -> b) -> a -> b
$
      Bool
-> Interpreter
-> IO ()
-> [Located DocTest]
-> StateT ReportState IO ()
runTestGroup Bool
preserveIt Interpreter
repl IO ()
setup_
  where
    reload :: IO ()
    reload :: IO ()
reload = do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
fastMode (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        -- NOTE: It is important to do the :reload first! See
        -- https://gitlab.haskell.org/ghc/ghc/-/issues/5904, which results in a
        -- panic on GHC 7.4.1 if you do the :reload second.
        IO (Either String String) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either String String) -> IO ())
-> IO (Either String String) -> IO ()
forall a b. (a -> b) -> a -> b
$ Interpreter -> String -> IO (Either String String)
Interpreter.safeEval Interpreter
repl String
":reload"
      IO (Either String String) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either String String) -> IO ())
-> IO (Either String String) -> IO ()
forall a b. (a -> b) -> a -> b
$ Interpreter -> String -> IO (Either String String)
Interpreter.safeEval Interpreter
repl (String -> IO (Either String String))
-> String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String
":m *" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
module_

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
preserveIt (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        -- Evaluate a dumb expression to populate the 'it' variable NOTE: This is
        -- one reason why we cannot have safeEval = safeEvalIt: 'it' isn't set in
        -- a fresh GHCi session.
        IO (Either String String) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either String String) -> IO ())
-> IO (Either String String) -> IO ()
forall a b. (a -> b) -> a -> b
$ Interpreter -> String -> IO (Either String String)
Interpreter.safeEval Interpreter
repl (String -> IO (Either String String))
-> String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String
"()"

    setup_ :: IO ()
    setup_ :: IO ()
setup_ = do
      IO ()
reload
      Maybe [Located DocTest] -> ([Located DocTest] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [Located DocTest]
setup (([Located DocTest] -> IO ()) -> IO ())
-> ([Located DocTest] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Located DocTest]
l -> [Located DocTest] -> (Located DocTest -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located DocTest]
l ((Located DocTest -> IO ()) -> IO ())
-> (Located DocTest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Located Location
_ DocTest
x) -> case DocTest
x of
        Property String
_  -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Example String
e ExpectedResult
_ -> IO (Either String String) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either String String) -> IO ())
-> IO (Either String String) -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Interpreter -> String -> IO (Either String String)
safeEvalWith Bool
preserveIt Interpreter
repl String
e

reportStart :: Location -> Expression -> String -> Report ()
reportStart :: Location -> String -> String -> StateT ReportState IO ()
reportStart Location
loc String
expression String
testType = do
  String -> StateT ReportState IO ()
verboseReport (String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"### Started execution at %s.\n### %s:\n%s" (Location -> String
forall a. Show a => a -> String
show Location
loc) String
testType String
expression)

reportFailure :: Location -> Expression -> [String] -> Report ()
reportFailure :: Location -> String -> [String] -> StateT ReportState IO ()
reportFailure Location
loc String
expression [String]
err = do
  String -> StateT ReportState IO ()
report (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s: failure in expression `%s'" (Location -> String
forall a. Show a => a -> String
show Location
loc) String
expression)
  (String -> StateT ReportState IO ())
-> [String] -> StateT ReportState IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> StateT ReportState IO ()
report [String]
err
  String -> StateT ReportState IO ()
report String
""
  Summary -> StateT ReportState IO ()
updateSummary (Int -> Int -> Int -> Int -> Summary
Summary Int
0 Int
1 Int
0 Int
1)

reportError :: Location -> Expression -> String -> Report ()
reportError :: Location -> String -> String -> StateT ReportState IO ()
reportError Location
loc String
expression String
err = do
  String -> StateT ReportState IO ()
report (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s: error in expression `%s'" (Location -> String
forall a. Show a => a -> String
show Location
loc) String
expression)
  String -> StateT ReportState IO ()
report String
err
  String -> StateT ReportState IO ()
report String
""
  Summary -> StateT ReportState IO ()
updateSummary (Int -> Int -> Int -> Int -> Summary
Summary Int
0 Int
1 Int
1 Int
0)

reportSuccess :: Report ()
reportSuccess :: StateT ReportState IO ()
reportSuccess = do
  String -> StateT ReportState IO ()
verboseReport String
"### Successful!\n"
  Summary -> StateT ReportState IO ()
updateSummary (Int -> Int -> Int -> Int -> Summary
Summary Int
0 Int
1 Int
0 Int
0)

verboseReport :: String -> Report ()
verboseReport :: String -> StateT ReportState IO ()
verboseReport String
msg = (ReportState -> Verbose) -> StateT ReportState IO Verbose
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ReportState -> Verbose
reportStateVerbose StateT ReportState IO Verbose
-> (Verbose -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall a b.
StateT ReportState IO a
-> (a -> StateT ReportState IO b) -> StateT ReportState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
  Verbose
NonVerbose -> StateT ReportState IO ()
forall (m :: * -> *). Monad m => m ()
pass
  Verbose
Verbose -> String -> StateT ReportState IO ()
report String
msg

updateSummary :: Summary -> Report ()
updateSummary :: Summary -> StateT ReportState IO ()
updateSummary Summary
summary = do
  IORef Summary
ref <- (ReportState -> IORef Summary)
-> StateT ReportState IO (IORef Summary)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ReportState -> IORef Summary
reportStateSummary
  IO () -> StateT ReportState IO ()
forall a. IO a -> StateT ReportState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT ReportState IO ())
-> IO () -> StateT ReportState IO ()
forall a b. (a -> b) -> a -> b
$ IORef Summary -> (Summary -> Summary) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Summary
ref ((Summary -> Summary) -> IO ()) -> (Summary -> Summary) -> IO ()
forall a b. (a -> b) -> a -> b
$ Summary -> Summary -> Summary
forall a. Monoid a => a -> a -> a
mappend Summary
summary
  StateT ReportState IO ()
reportProgress

reportProgress :: Report ()
reportProgress :: StateT ReportState IO ()
reportProgress = (ReportState -> Verbose) -> StateT ReportState IO Verbose
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ReportState -> Verbose
reportStateVerbose StateT ReportState IO Verbose
-> (Verbose -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall a b.
StateT ReportState IO a
-> (a -> StateT ReportState IO b) -> StateT ReportState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
  Verbose
NonVerbose -> do
    Summary
summary <- Report Summary
getSummary
    String -> StateT ReportState IO ()
reportTransient (Summary -> String
formatSummary Summary
summary)
  Verbose
Verbose -> StateT ReportState IO ()
forall (m :: * -> *). Monad m => m ()
pass

-- | Run given test group.
--
-- The interpreter state is zeroed with @:reload@ first.  This means that you
-- can reuse the same 'Interpreter' for several test groups.
runTestGroup :: Bool -> Interpreter -> IO () -> [Located DocTest] -> Report ()
runTestGroup :: Bool
-> Interpreter
-> IO ()
-> [Located DocTest]
-> StateT ReportState IO ()
runTestGroup Bool
preserveIt Interpreter
repl IO ()
setup [Located DocTest]
tests = do
  IO () -> StateT ReportState IO ()
forall a. IO a -> StateT ReportState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
setup
  Bool
-> Interpreter -> [Located Interaction] -> StateT ReportState IO ()
runExampleGroup Bool
preserveIt Interpreter
repl [Located Interaction]
examples

  [(Location, String)]
-> ((Location, String) -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Location, String)]
properties (((Location, String) -> StateT ReportState IO ())
 -> StateT ReportState IO ())
-> ((Location, String) -> StateT ReportState IO ())
-> StateT ReportState IO ()
forall a b. (a -> b) -> a -> b
$ \(Location
loc, String
expression) -> do
    PropertyResult
r <- do
      IO () -> StateT ReportState IO ()
forall a. IO a -> StateT ReportState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
setup
      Location -> String -> String -> StateT ReportState IO ()
reportStart Location
loc String
expression String
"property"
      IO PropertyResult -> StateT ReportState IO PropertyResult
forall a. IO a -> StateT ReportState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PropertyResult -> StateT ReportState IO PropertyResult)
-> IO PropertyResult -> StateT ReportState IO PropertyResult
forall a b. (a -> b) -> a -> b
$ Interpreter -> String -> IO PropertyResult
runProperty Interpreter
repl String
expression
    case PropertyResult
r of
      PropertyResult
Success ->
        StateT ReportState IO ()
reportSuccess
      Error String
err -> do
        Location -> String -> String -> StateT ReportState IO ()
reportError Location
loc String
expression String
err
      Failure String
msg -> do
        Location -> String -> [String] -> StateT ReportState IO ()
reportFailure Location
loc String
expression [String
msg]
  where
    properties :: [(Location, String)]
properties = [(Location
loc, String
p) | Located Location
loc (Property String
p) <- [Located DocTest]
tests]

    examples :: [Located Interaction]
    examples :: [Located Interaction]
examples = [Location -> Interaction -> Located Interaction
forall a. Location -> a -> Located a
Located Location
loc (String
e, ExpectedResult
r) | Located Location
loc (Example String
e ExpectedResult
r) <- [Located DocTest]
tests]

type Interaction = (Expression, ExpectedResult)

-- |
-- Execute all expressions from given example in given 'Interpreter' and verify
-- the output.
runExampleGroup :: Bool -> Interpreter -> [Located Interaction] -> Report ()
runExampleGroup :: Bool
-> Interpreter -> [Located Interaction] -> StateT ReportState IO ()
runExampleGroup Bool
preserveIt Interpreter
repl = [Located Interaction] -> StateT ReportState IO ()
go
  where
    go :: [Located Interaction] -> StateT ReportState IO ()
go ((Located Location
loc (String
expression, ExpectedResult
expected)) : [Located Interaction]
xs) = do
      Location -> String -> String -> StateT ReportState IO ()
reportStart Location
loc String
expression String
"example"
      Either String [String]
r <- (String -> [String])
-> Either String String -> Either String [String]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> [String]
lines (Either String String -> Either String [String])
-> StateT ReportState IO (Either String String)
-> StateT ReportState IO (Either String [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either String String)
-> StateT ReportState IO (Either String String)
forall a. IO a -> StateT ReportState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> Interpreter -> String -> IO (Either String String)
safeEvalWith Bool
preserveIt Interpreter
repl String
expression)
      case Either String [String]
r of
        Left String
err -> do
          Location -> String -> String -> StateT ReportState IO ()
reportError Location
loc String
expression String
err
        Right [String]
actual -> case ExpectedResult -> [String] -> Result
mkResult ExpectedResult
expected [String]
actual of
          NotEqual [String]
err -> do
            Location -> String -> [String] -> StateT ReportState IO ()
reportFailure Location
loc String
expression [String]
err
          Result
Equal -> do
            StateT ReportState IO ()
reportSuccess
            [Located Interaction] -> StateT ReportState IO ()
go [Located Interaction]
xs
    go [] = () -> StateT ReportState IO ()
forall a. a -> StateT ReportState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

safeEvalWith :: Bool -> Interpreter -> String -> IO (Either String String)
safeEvalWith :: Bool -> Interpreter -> String -> IO (Either String String)
safeEvalWith Bool
preserveIt
  | Bool
preserveIt = Interpreter -> String -> IO (Either String String)
Interpreter.safeEvalIt
  | Bool
otherwise  = Interpreter -> String -> IO (Either String String)
Interpreter.safeEval