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

#ifdef TEST
, Report
, ReportState(..)
, runReport
, 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.Class
import           Control.Monad.Trans.Maybe
import           Control.Monad.Trans.State (StateT, evalStateT)
import qualified Control.Monad.Trans.State as State
import           Control.Monad.IO.Class
import           Data.IORef

import           Interpreter (Interpreter, PreserveIt(..), safeEvalWith)
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 -> [Char]
show = Summary -> [Char]
formatSummary

isSuccess :: Summary -> Bool
isSuccess :: Summary -> Bool
isSuccess Summary
s = Summary -> Int
sErrors Summary
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Summary -> Int
sFailures Summary
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

formatSummary :: Summary -> String
formatSummary :: Summary -> [Char]
formatSummary (Summary Int
examples Int
tried Int
errors Int
failures) =
  [Char] -> Int -> Int -> Int -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"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
instance Semigroup Summary where
  Summary Int
x1 Int
x2 Int
x3 Int
x4 <> :: Summary -> Summary -> Summary
<> 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 :: FastMode -> PreserveIt -> FailFast -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary
runModules :: FastMode
-> PreserveIt
-> FailFast
-> Verbose
-> Interpreter
-> [Module [Located DocTest]]
-> IO Summary
runModules FastMode
fastMode PreserveIt
preserveIt FailFast
failFast 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 <- 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

  summary <- newIORef mempty {sExamples = n}

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

    run :: IO ()
    run = ReportState -> Report () -> IO ()
runReport (Interactive -> FailFast -> Verbose -> IORef Summary -> ReportState
ReportState Interactive
interactive FailFast
failFast Verbose
verbose IORef Summary
summary) (Report () -> IO ()) -> Report () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Report ()
reportProgress
      [Module [Located DocTest]]
-> (Module [Located DocTest] -> Report ()) -> Report ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Module [Located DocTest]]
modules ((Module [Located DocTest] -> Report ()) -> Report ())
-> (Module [Located DocTest] -> Report ()) -> Report ()
forall a b. (a -> b) -> a -> b
$ FastMode
-> PreserveIt
-> Interpreter
-> Module [Located DocTest]
-> Report ()
runModule FastMode
fastMode PreserveIt
preserveIt Interpreter
repl
      [Char] -> Report ()
verboseReport [Char]
"# Final summary:"

  run `finally` reportFinalResult

  readIORef 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 [Char]
_ 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 = MaybeT (StateT ReportState IO)

data Interactive = NonInteractive | Interactive

data FastMode = NoFastMode | FastMode

data FailFast = NoFailFast | FailFast

data Verbose = NonVerbose | Verbose

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

runReport :: ReportState -> Report () -> IO ()
runReport :: ReportState -> Report () -> IO ()
runReport ReportState
st = IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ())
-> (Report () -> IO (Maybe ())) -> Report () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT ReportState IO (Maybe ()) -> ReportState -> IO (Maybe ()))
-> ReportState -> StateT ReportState IO (Maybe ()) -> IO (Maybe ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ReportState IO (Maybe ()) -> ReportState -> IO (Maybe ())
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ReportState
st (StateT ReportState IO (Maybe ()) -> IO (Maybe ()))
-> (Report () -> StateT ReportState IO (Maybe ()))
-> Report ()
-> IO (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Report () -> StateT ReportState IO (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

getSummary :: Report Summary
getSummary :: Report Summary
getSummary = (ReportState -> IORef Summary) -> Report (IORef Summary)
forall a. (ReportState -> a) -> Report a
gets ReportState -> IORef Summary
reportStateSummary Report (IORef Summary)
-> (IORef Summary -> Report Summary) -> Report Summary
forall a b.
MaybeT (StateT ReportState IO) a
-> (a -> MaybeT (StateT ReportState IO) b)
-> MaybeT (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 -> MaybeT (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

gets :: (ReportState -> a) -> Report a
gets :: forall a. (ReportState -> a) -> Report a
gets = StateT ReportState IO a -> MaybeT (StateT ReportState IO) a
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ReportState IO a -> MaybeT (StateT ReportState IO) a)
-> ((ReportState -> a) -> StateT ReportState IO a)
-> (ReportState -> a)
-> MaybeT (StateT ReportState IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReportState -> a) -> StateT ReportState IO a
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets

-- | Add output to the report.
report :: String -> Report ()
report :: [Char] -> Report ()
report = IO () -> Report ()
forall a. IO a -> MaybeT (StateT ReportState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Report ()) -> ([Char] -> IO ()) -> [Char] -> Report ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> [Char] -> 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 :: [Char] -> Report ()
reportTransient [Char]
msg = (ReportState -> Interactive) -> Report Interactive
forall a. (ReportState -> a) -> Report a
gets ReportState -> Interactive
reportStateInteractive Report Interactive -> (Interactive -> Report ()) -> Report ()
forall a b.
MaybeT (StateT ReportState IO) a
-> (a -> MaybeT (StateT ReportState IO) b)
-> MaybeT (StateT ReportState IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
  Interactive
NonInteractive -> Report ()
forall (m :: * -> *). Monad m => m ()
pass
  Interactive
Interactive -> IO () -> Report ()
forall a. IO a -> MaybeT (StateT ReportState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Report ()) -> IO () -> Report ()
forall a b. (a -> b) -> a -> b
$ do
    Handle -> [Char] -> IO ()
hPutStr Handle
stderr [Char]
msg
    Handle -> IO ()
hFlush Handle
stderr
    Handle -> [Char] -> IO ()
hPutStr Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Char
'\r' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
msg) Char
' ') [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\r"

-- | Run all examples from given module.
runModule :: FastMode -> PreserveIt -> Interpreter -> Module [Located DocTest] -> Report ()
runModule :: FastMode
-> PreserveIt
-> Interpreter
-> Module [Located DocTest]
-> Report ()
runModule FastMode
fastMode PreserveIt
preserveIt Interpreter
repl (Module [Char]
module_ Maybe [Located DocTest]
setup [[Located DocTest]]
examples) = do

  Summary _ _ e0 f0 <- Report Summary
getSummary

  forM_ setup $
    runTestGroup preserveIt repl reload

  Summary _ _ e1 f1 <- getSummary

  -- only run tests, if setup does not produce any errors/failures
  when (e0 == e1 && f0 == f1) $
    forM_ examples $ runTestGroup preserveIt repl setup_
  where
    reload :: IO ()
    reload :: IO ()
reload = do
      case FastMode
fastMode of
        FastMode
NoFastMode -> IO (Either [Char] [Char]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either [Char] [Char]) -> IO ())
-> IO (Either [Char] [Char]) -> IO ()
forall a b. (a -> b) -> a -> b
$ Interpreter -> [Char] -> IO (Either [Char] [Char])
Interpreter.safeEval Interpreter
repl [Char]
":reload"
        FastMode
FastMode -> IO ()
forall (m :: * -> *). Monad m => m ()
pass
      IO (Either [Char] [Char]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either [Char] [Char]) -> IO ())
-> IO (Either [Char] [Char]) -> IO ()
forall a b. (a -> b) -> a -> b
$ Interpreter -> [Char] -> IO (Either [Char] [Char])
Interpreter.safeEval Interpreter
repl ([Char] -> IO (Either [Char] [Char]))
-> [Char] -> IO (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
":m *" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
module_

      case PreserveIt
preserveIt of
        PreserveIt
NoPreserveIt -> IO ()
forall (m :: * -> *). Monad m => m ()
pass
        PreserveIt
PreserveIt -> do
          -- Evaluate a dumb expression to populate the 'it' variable.
          --
          -- NOTE: This is one reason why we cannot just always use PreserveIt:
          -- 'it' isn't set in a fresh GHCi session.
          IO (Either [Char] [Char]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either [Char] [Char]) -> IO ())
-> IO (Either [Char] [Char]) -> IO ()
forall a b. (a -> b) -> a -> b
$ Interpreter -> [Char] -> IO (Either [Char] [Char])
Interpreter.safeEval Interpreter
repl ([Char] -> IO (Either [Char] [Char]))
-> [Char] -> IO (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
"()"

    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 [Char]
_  -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Example [Char]
e ExpectedResult
_ -> IO (Either [Char] [Char]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either [Char] [Char]) -> IO ())
-> IO (Either [Char] [Char]) -> IO ()
forall a b. (a -> b) -> a -> b
$ PreserveIt -> Interpreter -> [Char] -> IO (Either [Char] [Char])
safeEvalWith PreserveIt
preserveIt Interpreter
repl [Char]
e

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

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

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

reportSuccess :: Report ()
reportSuccess :: Report ()
reportSuccess = do
  [Char] -> Report ()
verboseReport [Char]
"### Successful!\n"
  Summary -> Report ()
updateSummary (Int -> Int -> Int -> Int -> Summary
Summary Int
0 Int
1 Int
0 Int
0)

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

updateSummary :: Summary -> Report ()
updateSummary :: Summary -> Report ()
updateSummary Summary
summary = do
  ref <- (ReportState -> IORef Summary) -> Report (IORef Summary)
forall a. (ReportState -> a) -> Report a
gets ReportState -> IORef Summary
reportStateSummary
  liftIO $ modifyIORef' ref $ mappend summary
  reportProgress
  gets reportStateFailFast >>= \ case
    FailFast
NoFailFast -> Report ()
forall (m :: * -> *). Monad m => m ()
pass
    FailFast
FailFast -> Bool -> Report () -> Report ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Summary -> Bool
isSuccess Summary
summary) Report ()
abort

abort :: Report ()
abort :: Report ()
abort = StateT ReportState IO (Maybe ()) -> Report ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (StateT ReportState IO (Maybe ()) -> Report ())
-> StateT ReportState IO (Maybe ()) -> Report ()
forall a b. (a -> b) -> a -> b
$ Maybe () -> StateT ReportState IO (Maybe ())
forall a. a -> StateT ReportState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ()
forall a. Maybe a
Nothing

reportProgress :: Report ()
reportProgress :: Report ()
reportProgress = (ReportState -> Verbose) -> Report Verbose
forall a. (ReportState -> a) -> Report a
gets ReportState -> Verbose
reportStateVerbose Report Verbose -> (Verbose -> Report ()) -> Report ()
forall a b.
MaybeT (StateT ReportState IO) a
-> (a -> MaybeT (StateT ReportState IO) b)
-> MaybeT (StateT ReportState IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
  Verbose
NonVerbose -> do
    summary <- Report Summary
getSummary
    reportTransient (formatSummary summary)
  Verbose
Verbose -> Report ()
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 :: PreserveIt -> Interpreter -> IO () -> [Located DocTest] -> Report ()
runTestGroup :: PreserveIt
-> Interpreter -> IO () -> [Located DocTest] -> Report ()
runTestGroup PreserveIt
preserveIt Interpreter
repl IO ()
setup [Located DocTest]
tests = do
  IO () -> Report ()
forall a. IO a -> MaybeT (StateT ReportState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
setup
  PreserveIt -> Interpreter -> [Located Interaction] -> Report ()
runExampleGroup PreserveIt
preserveIt Interpreter
repl [Located Interaction]
examples

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

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

type Interaction = (Expression, ExpectedResult)

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