{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
module Test.Internal where
import qualified Control.Concurrent.MVar as MVar
import qualified Control.Exception.Safe as Exception
import qualified Control.Monad.IO.Class
import qualified Data.Either
import qualified Data.IORef as IORef
import qualified Dict
import qualified GHC.Stack as Stack
import qualified Hedgehog
import qualified Hedgehog.Internal.Property
import qualified Hedgehog.Internal.Report
import qualified Hedgehog.Internal.Runner
import qualified Hedgehog.Internal.Seed
import qualified List
import qualified Maybe
import NriPrelude
import Platform (TracingSpan)
import qualified Platform
import qualified Platform.Internal
import qualified Task
import qualified Tuple
import qualified Prelude
data SingleTest a = SingleTest
{ SingleTest a -> [Text]
describes :: [Text],
SingleTest a -> Text
name :: Text,
SingleTest a -> Label
label :: Label,
SingleTest a -> Maybe SrcLoc
loc :: Maybe Stack.SrcLoc,
SingleTest a -> a
body :: a
}
deriving (a -> SingleTest b -> SingleTest a
(a -> b) -> SingleTest a -> SingleTest b
(forall a b. (a -> b) -> SingleTest a -> SingleTest b)
-> (forall a b. a -> SingleTest b -> SingleTest a)
-> Functor SingleTest
forall a b. a -> SingleTest b -> SingleTest a
forall a b. (a -> b) -> SingleTest a -> SingleTest b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SingleTest b -> SingleTest a
$c<$ :: forall a b. a -> SingleTest b -> SingleTest a
fmap :: (a -> b) -> SingleTest a -> SingleTest b
$cfmap :: forall a b. (a -> b) -> SingleTest a -> SingleTest b
Prelude.Functor)
data Label = None | Skip | Only | Todo
deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Eq Label
Eq Label
-> (Label -> Label -> Ordering)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Label)
-> (Label -> Label -> Label)
-> Ord Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
$cp1Ord :: Eq Label
Ord)
data TestResult
= Succeeded
| Failed Failure
data Failure
= FailedAssertion Text (Maybe Stack.SrcLoc)
| ThrewException Exception.SomeException
| TookTooLong
| TestRunnerMessedUp Text
deriving (Int -> Failure -> ShowS
[Failure] -> ShowS
Failure -> String
(Int -> Failure -> ShowS)
-> (Failure -> String) -> ([Failure] -> ShowS) -> Show Failure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Failure] -> ShowS
$cshowList :: [Failure] -> ShowS
show :: Failure -> String
$cshow :: Failure -> String
showsPrec :: Int -> Failure -> ShowS
$cshowsPrec :: Int -> Failure -> ShowS
Show)
instance Exception.Exception Failure
data SuiteResult
= AllPassed [SingleTest TracingSpan]
| OnlysPassed [SingleTest TracingSpan] [SingleTest NotRan]
| PassedWithSkipped [SingleTest TracingSpan] [SingleTest NotRan]
| TestsFailed [SingleTest TracingSpan] [SingleTest NotRan] [SingleTest (TracingSpan, Failure)]
| NoTestsInSuite
data NotRan = NotRan
newtype Test = Test {Test -> [SingleTest Expectation]
unTest :: [SingleTest Expectation]}
type Expectation = Expectation' ()
newtype Expectation' a = Expectation {Expectation' a -> Task Failure a
unExpectation :: Task Failure a}
deriving (a -> Expectation' b -> Expectation' a
(a -> b) -> Expectation' a -> Expectation' b
(forall a b. (a -> b) -> Expectation' a -> Expectation' b)
-> (forall a b. a -> Expectation' b -> Expectation' a)
-> Functor Expectation'
forall a b. a -> Expectation' b -> Expectation' a
forall a b. (a -> b) -> Expectation' a -> Expectation' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Expectation' b -> Expectation' a
$c<$ :: forall a b. a -> Expectation' b -> Expectation' a
fmap :: (a -> b) -> Expectation' a -> Expectation' b
$cfmap :: forall a b. (a -> b) -> Expectation' a -> Expectation' b
Prelude.Functor, Functor Expectation'
a -> Expectation' a
Functor Expectation'
-> (forall a. a -> Expectation' a)
-> (forall a b.
Expectation' (a -> b) -> Expectation' a -> Expectation' b)
-> (forall a b c.
(a -> b -> c)
-> Expectation' a -> Expectation' b -> Expectation' c)
-> (forall a b. Expectation' a -> Expectation' b -> Expectation' b)
-> (forall a b. Expectation' a -> Expectation' b -> Expectation' a)
-> Applicative Expectation'
Expectation' a -> Expectation' b -> Expectation' b
Expectation' a -> Expectation' b -> Expectation' a
Expectation' (a -> b) -> Expectation' a -> Expectation' b
(a -> b -> c) -> Expectation' a -> Expectation' b -> Expectation' c
forall a. a -> Expectation' a
forall a b. Expectation' a -> Expectation' b -> Expectation' a
forall a b. Expectation' a -> Expectation' b -> Expectation' b
forall a b.
Expectation' (a -> b) -> Expectation' a -> Expectation' b
forall a b c.
(a -> b -> c) -> Expectation' a -> Expectation' b -> Expectation' c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Expectation' a -> Expectation' b -> Expectation' a
$c<* :: forall a b. Expectation' a -> Expectation' b -> Expectation' a
*> :: Expectation' a -> Expectation' b -> Expectation' b
$c*> :: forall a b. Expectation' a -> Expectation' b -> Expectation' b
liftA2 :: (a -> b -> c) -> Expectation' a -> Expectation' b -> Expectation' c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Expectation' a -> Expectation' b -> Expectation' c
<*> :: Expectation' (a -> b) -> Expectation' a -> Expectation' b
$c<*> :: forall a b.
Expectation' (a -> b) -> Expectation' a -> Expectation' b
pure :: a -> Expectation' a
$cpure :: forall a. a -> Expectation' a
$cp1Applicative :: Functor Expectation'
Prelude.Applicative, Applicative Expectation'
a -> Expectation' a
Applicative Expectation'
-> (forall a b.
Expectation' a -> (a -> Expectation' b) -> Expectation' b)
-> (forall a b. Expectation' a -> Expectation' b -> Expectation' b)
-> (forall a. a -> Expectation' a)
-> Monad Expectation'
Expectation' a -> (a -> Expectation' b) -> Expectation' b
Expectation' a -> Expectation' b -> Expectation' b
forall a. a -> Expectation' a
forall a b. Expectation' a -> Expectation' b -> Expectation' b
forall a b.
Expectation' a -> (a -> Expectation' b) -> Expectation' b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Expectation' a
$creturn :: forall a. a -> Expectation' a
>> :: Expectation' a -> Expectation' b -> Expectation' b
$c>> :: forall a b. Expectation' a -> Expectation' b -> Expectation' b
>>= :: Expectation' a -> (a -> Expectation' b) -> Expectation' b
$c>>= :: forall a b.
Expectation' a -> (a -> Expectation' b) -> Expectation' b
$cp1Monad :: Applicative Expectation'
Prelude.Monad)
newtype Fuzzer a = Fuzzer {Fuzzer a -> Gen a
unFuzzer :: Hedgehog.Gen a}
deriving (a -> Fuzzer b -> Fuzzer a
(a -> b) -> Fuzzer a -> Fuzzer b
(forall a b. (a -> b) -> Fuzzer a -> Fuzzer b)
-> (forall a b. a -> Fuzzer b -> Fuzzer a) -> Functor Fuzzer
forall a b. a -> Fuzzer b -> Fuzzer a
forall a b. (a -> b) -> Fuzzer a -> Fuzzer b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Fuzzer b -> Fuzzer a
$c<$ :: forall a b. a -> Fuzzer b -> Fuzzer a
fmap :: (a -> b) -> Fuzzer a -> Fuzzer b
$cfmap :: forall a b. (a -> b) -> Fuzzer a -> Fuzzer b
Prelude.Functor, Functor Fuzzer
a -> Fuzzer a
Functor Fuzzer
-> (forall a. a -> Fuzzer a)
-> (forall a b. Fuzzer (a -> b) -> Fuzzer a -> Fuzzer b)
-> (forall a b c.
(a -> b -> c) -> Fuzzer a -> Fuzzer b -> Fuzzer c)
-> (forall a b. Fuzzer a -> Fuzzer b -> Fuzzer b)
-> (forall a b. Fuzzer a -> Fuzzer b -> Fuzzer a)
-> Applicative Fuzzer
Fuzzer a -> Fuzzer b -> Fuzzer b
Fuzzer a -> Fuzzer b -> Fuzzer a
Fuzzer (a -> b) -> Fuzzer a -> Fuzzer b
(a -> b -> c) -> Fuzzer a -> Fuzzer b -> Fuzzer c
forall a. a -> Fuzzer a
forall a b. Fuzzer a -> Fuzzer b -> Fuzzer a
forall a b. Fuzzer a -> Fuzzer b -> Fuzzer b
forall a b. Fuzzer (a -> b) -> Fuzzer a -> Fuzzer b
forall a b c. (a -> b -> c) -> Fuzzer a -> Fuzzer b -> Fuzzer c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Fuzzer a -> Fuzzer b -> Fuzzer a
$c<* :: forall a b. Fuzzer a -> Fuzzer b -> Fuzzer a
*> :: Fuzzer a -> Fuzzer b -> Fuzzer b
$c*> :: forall a b. Fuzzer a -> Fuzzer b -> Fuzzer b
liftA2 :: (a -> b -> c) -> Fuzzer a -> Fuzzer b -> Fuzzer c
$cliftA2 :: forall a b c. (a -> b -> c) -> Fuzzer a -> Fuzzer b -> Fuzzer c
<*> :: Fuzzer (a -> b) -> Fuzzer a -> Fuzzer b
$c<*> :: forall a b. Fuzzer (a -> b) -> Fuzzer a -> Fuzzer b
pure :: a -> Fuzzer a
$cpure :: forall a. a -> Fuzzer a
$cp1Applicative :: Functor Fuzzer
Prelude.Applicative)
describe :: Text -> [Test] -> Test
describe :: Text -> [Test] -> Test
describe Text
description [Test]
tests =
[Test]
tests
[Test]
-> ([Test] -> [SingleTest Expectation]) -> [SingleTest Expectation]
forall a b. a -> (a -> b) -> b
|> (Test -> [SingleTest Expectation])
-> [Test] -> [SingleTest Expectation]
forall a b. (a -> List b) -> List a -> List b
List.concatMap Test -> [SingleTest Expectation]
unTest
[SingleTest Expectation]
-> ([SingleTest Expectation] -> [SingleTest Expectation])
-> [SingleTest Expectation]
forall a b. a -> (a -> b) -> b
|> (SingleTest Expectation -> SingleTest Expectation)
-> [SingleTest Expectation] -> [SingleTest Expectation]
forall a b. (a -> b) -> List a -> List b
List.map (\SingleTest Expectation
test' -> SingleTest Expectation
test' {describes :: [Text]
describes = Text
description Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: SingleTest Expectation -> [Text]
forall a. SingleTest a -> [Text]
describes SingleTest Expectation
test'})
[SingleTest Expectation]
-> ([SingleTest Expectation] -> Test) -> Test
forall a b. a -> (a -> b) -> b
|> [SingleTest Expectation] -> Test
Test
todo :: Stack.HasCallStack => Text -> Test
todo :: Text -> Test
todo Text
name =
[SingleTest Expectation] -> Test
Test
[ SingleTest :: forall a.
[Text] -> Text -> Label -> Maybe SrcLoc -> a -> SingleTest a
SingleTest
{ describes :: [Text]
describes = [],
name :: Text
name = Text
name,
loc :: Maybe SrcLoc
loc = (HasCallStack => Maybe SrcLoc) -> Maybe SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Maybe SrcLoc
getFrame,
label :: Label
label = Label
Todo,
body :: Expectation
body = Task Failure () -> Expectation
forall a. Task Failure a -> Expectation' a
Expectation (() -> Task Failure ()
forall a x. a -> Task x a
Task.succeed ())
}
]
test :: Stack.HasCallStack => Text -> (() -> Expectation) -> Test
test :: Text -> (() -> Expectation) -> Test
test Text
name () -> Expectation
expectation =
[SingleTest Expectation] -> Test
Test
[ SingleTest :: forall a.
[Text] -> Text -> Label -> Maybe SrcLoc -> a -> SingleTest a
SingleTest
{ describes :: [Text]
describes = [],
name :: Text
name = Text
name,
loc :: Maybe SrcLoc
loc = (HasCallStack => Maybe SrcLoc) -> Maybe SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Maybe SrcLoc
getFrame,
label :: Label
label = Label
None,
body :: Expectation
body = Expectation -> Expectation
handleUnexpectedErrors (() -> Expectation
expectation ())
}
]
fuzz :: (Stack.HasCallStack, Show a) => Fuzzer a -> Text -> (a -> Expectation) -> Test
fuzz :: Fuzzer a -> Text -> (a -> Expectation) -> Test
fuzz Fuzzer a
fuzzer Text
name a -> Expectation
expectation =
[SingleTest Expectation] -> Test
Test
[ SingleTest :: forall a.
[Text] -> Text -> Label -> Maybe SrcLoc -> a -> SingleTest a
SingleTest
{ describes :: [Text]
describes = [],
name :: Text
name = Text
name,
loc :: Maybe SrcLoc
loc = (HasCallStack => Maybe SrcLoc) -> Maybe SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Maybe SrcLoc
getFrame,
label :: Label
label = Label
None,
body :: Expectation
body = Fuzzer a -> (a -> Expectation) -> Expectation
forall a. Show a => Fuzzer a -> (a -> Expectation) -> Expectation
fuzzBody Fuzzer a
fuzzer a -> Expectation
expectation
}
]
fuzz2 :: (Stack.HasCallStack, Show a, Show b) => Fuzzer a -> Fuzzer b -> Text -> (a -> b -> Expectation) -> Test
fuzz2 :: Fuzzer a -> Fuzzer b -> Text -> (a -> b -> Expectation) -> Test
fuzz2 (Fuzzer Gen a
genA) (Fuzzer Gen b
genB) Text
name a -> b -> Expectation
expectation =
[SingleTest Expectation] -> Test
Test
[ SingleTest :: forall a.
[Text] -> Text -> Label -> Maybe SrcLoc -> a -> SingleTest a
SingleTest
{ describes :: [Text]
describes = [],
name :: Text
name = Text
name,
loc :: Maybe SrcLoc
loc = (HasCallStack => Maybe SrcLoc) -> Maybe SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Maybe SrcLoc
getFrame,
label :: Label
label = Label
None,
body :: Expectation
body =
Fuzzer (a, b) -> ((a, b) -> Expectation) -> Expectation
forall a. Show a => Fuzzer a -> (a -> Expectation) -> Expectation
fuzzBody
(Gen (a, b) -> Fuzzer (a, b)
forall a. Gen a -> Fuzzer a
Fuzzer ((a -> b -> (a, b)) -> Gen a -> Gen b -> Gen (a, b)
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
map2 (,) Gen a
genA Gen b
genB))
(\(a
a, b
b) -> a -> b -> Expectation
expectation a
a b
b)
}
]
fuzz3 :: (Stack.HasCallStack, Show a, Show b, Show c) => Fuzzer a -> Fuzzer b -> Fuzzer c -> Text -> (a -> b -> c -> Expectation) -> Test
fuzz3 :: Fuzzer a
-> Fuzzer b
-> Fuzzer c
-> Text
-> (a -> b -> c -> Expectation)
-> Test
fuzz3 (Fuzzer Gen a
genA) (Fuzzer Gen b
genB) (Fuzzer Gen c
genC) Text
name a -> b -> c -> Expectation
expectation =
[SingleTest Expectation] -> Test
Test
[ SingleTest :: forall a.
[Text] -> Text -> Label -> Maybe SrcLoc -> a -> SingleTest a
SingleTest
{ describes :: [Text]
describes = [],
name :: Text
name = Text
name,
loc :: Maybe SrcLoc
loc = (HasCallStack => Maybe SrcLoc) -> Maybe SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Maybe SrcLoc
getFrame,
label :: Label
label = Label
None,
body :: Expectation
body =
Fuzzer (a, b, c) -> ((a, b, c) -> Expectation) -> Expectation
forall a. Show a => Fuzzer a -> (a -> Expectation) -> Expectation
fuzzBody
(Gen (a, b, c) -> Fuzzer (a, b, c)
forall a. Gen a -> Fuzzer a
Fuzzer ((a -> b -> c -> (a, b, c))
-> Gen a -> Gen b -> Gen c -> Gen (a, b, c)
forall (m :: * -> *) a b c value.
Applicative m =>
(a -> b -> c -> value) -> m a -> m b -> m c -> m value
map3 (,,) Gen a
genA Gen b
genB Gen c
genC))
(\(a
a, b
b, c
c) -> a -> b -> c -> Expectation
expectation a
a b
b c
c)
}
]
fuzzBody :: Show a => Fuzzer a -> (a -> Expectation) -> Expectation
fuzzBody :: Fuzzer a -> (a -> Expectation) -> Expectation
fuzzBody (Fuzzer Gen a
gen) a -> Expectation
expectation = do
Task Failure () -> Expectation
forall a. Task Failure a -> Expectation' a
Expectation
(Task Failure () -> Expectation) -> Task Failure () -> Expectation
forall a b. (a -> b) -> a -> b
<| (LogHandler -> IO (Result Failure ())) -> Task Failure ()
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Platform.Internal.Task
( \LogHandler
_log -> do
LogHandler
silentLog <- IO LogHandler
Platform.silentHandler
Seed
seed <- IO Seed
forall (m :: * -> *). MonadIO m => m Seed
Hedgehog.Internal.Seed.random
IORef (Maybe Failure)
failureRef <- Maybe Failure -> IO (IORef (Maybe Failure))
forall a. a -> IO (IORef a)
IORef.newIORef Maybe Failure
forall a. Maybe a
Nothing
Report Result
hedgehogResult <-
PropertyConfig
-> Size
-> Seed
-> PropertyT IO ()
-> (Report Progress -> IO ())
-> IO (Report Result)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
PropertyConfig
-> Size
-> Seed
-> PropertyT m ()
-> (Report Progress -> m ())
-> m (Report Result)
Hedgehog.Internal.Runner.checkReport
PropertyConfig
Hedgehog.Internal.Property.defaultConfig
Size
0
Seed
seed
( do
a
generated <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
Hedgehog.forAll Gen a
gen
Result Failure ()
result <-
a -> Expectation
expectation a
generated
Expectation -> (Expectation -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> Expectation -> Expectation
handleUnexpectedErrors
Expectation -> (Expectation -> Task Failure ()) -> Task Failure ()
forall a b. a -> (a -> b) -> b
|> Expectation -> Task Failure ()
forall a. Expectation' a -> Task Failure a
unExpectation
Task Failure ()
-> (Task Failure () -> Task Failure (Result Failure ()))
-> Task Failure (Result Failure ())
forall a b. a -> (a -> b) -> b
|> (() -> Result Failure ())
-> Task Failure () -> Task Failure (Result Failure ())
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map () -> Result Failure ()
forall error value. value -> Result error value
Ok
Task Failure (Result Failure ())
-> (Task Failure (Result Failure ())
-> Task Never (Result Failure ()))
-> Task Never (Result Failure ())
forall a b. a -> (a -> b) -> b
|> (Failure -> Task Never (Result Failure ()))
-> Task Failure (Result Failure ())
-> Task Never (Result Failure ())
forall x y a. (x -> Task y a) -> Task x a -> Task y a
Task.onError (Result Failure () -> Task Never (Result Failure ())
forall a x. a -> Task x a
Task.succeed (Result Failure () -> Task Never (Result Failure ()))
-> (Failure -> Result Failure ())
-> Failure
-> Task Never (Result Failure ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Failure -> Result Failure ()
forall error value. error -> Result error value
Err)
Task Never (Result Failure ())
-> (Task Never (Result Failure ()) -> IO (Result Failure ()))
-> IO (Result Failure ())
forall a b. a -> (a -> b) -> b
|> LogHandler
-> Task Never (Result Failure ()) -> IO (Result Failure ())
forall a. LogHandler -> Task Never a -> IO a
Task.perform LogHandler
silentLog
IO (Result Failure ())
-> (IO (Result Failure ()) -> PropertyT IO (Result Failure ()))
-> PropertyT IO (Result Failure ())
forall a b. a -> (a -> b) -> b
|> IO (Result Failure ()) -> PropertyT IO (Result Failure ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Control.Monad.IO.Class.liftIO
case Result Failure ()
result of
Ok () -> () -> PropertyT IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()
Err Failure
failure -> do
IORef (Maybe Failure) -> Maybe Failure -> IO ()
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef (Maybe Failure)
failureRef (Failure -> Maybe Failure
forall a. a -> Maybe a
Just Failure
failure)
IO () -> (IO () -> PropertyT IO ()) -> PropertyT IO ()
forall a b. a -> (a -> b) -> b
|> IO () -> PropertyT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Control.Monad.IO.Class.liftIO
PropertyT IO ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
Hedgehog.failure
)
(\Report Progress
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ())
case Report Result -> Result
forall a. Report a -> a
Hedgehog.Internal.Report.reportStatus Report Result
hedgehogResult of
Hedgehog.Internal.Report.Failed FailureReport
_ -> do
Maybe Failure
maybeFailure <- IORef (Maybe Failure) -> IO (Maybe Failure)
forall a. IORef a -> IO a
IORef.readIORef IORef (Maybe Failure)
failureRef
case Maybe Failure
maybeFailure of
Maybe Failure
Nothing ->
Text -> Failure
TestRunnerMessedUp Text
"I lost the error report of a failed fuzz test test."
Failure -> (Failure -> Result Failure ()) -> Result Failure ()
forall a b. a -> (a -> b) -> b
|> Failure -> Result Failure ()
forall error value. error -> Result error value
Err
Result Failure ()
-> (Result Failure () -> IO (Result Failure ()))
-> IO (Result Failure ())
forall a b. a -> (a -> b) -> b
|> Result Failure () -> IO (Result Failure ())
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
Just Failure
failure ->
Failure -> Result Failure ()
forall error value. error -> Result error value
Err Failure
failure
Result Failure ()
-> (Result Failure () -> IO (Result Failure ()))
-> IO (Result Failure ())
forall a b. a -> (a -> b) -> b
|> Result Failure () -> IO (Result Failure ())
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
Result
Hedgehog.Internal.Report.GaveUp ->
Text -> Failure
TestRunnerMessedUp Text
"I couldn't generate any values for a fuzz test."
Failure -> (Failure -> Result Failure ()) -> Result Failure ()
forall a b. a -> (a -> b) -> b
|> Failure -> Result Failure ()
forall error value. error -> Result error value
Err
Result Failure ()
-> (Result Failure () -> IO (Result Failure ()))
-> IO (Result Failure ())
forall a b. a -> (a -> b) -> b
|> Result Failure () -> IO (Result Failure ())
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
Result
Hedgehog.Internal.Report.OK ->
() -> Result Failure ()
forall error value. value -> Result error value
Ok ()
Result Failure ()
-> (Result Failure () -> IO (Result Failure ()))
-> IO (Result Failure ())
forall a b. a -> (a -> b) -> b
|> Result Failure () -> IO (Result Failure ())
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
)
skip :: Test -> Test
skip :: Test -> Test
skip (Test [SingleTest Expectation]
tests) =
[SingleTest Expectation] -> Test
Test ([SingleTest Expectation] -> Test)
-> [SingleTest Expectation] -> Test
forall a b. (a -> b) -> a -> b
<| (SingleTest Expectation -> SingleTest Expectation)
-> [SingleTest Expectation] -> [SingleTest Expectation]
forall a b. (a -> b) -> List a -> List b
List.map (\SingleTest Expectation
test' -> SingleTest Expectation
test' {label :: Label
label = Label
Skip}) [SingleTest Expectation]
tests
only :: Test -> Test
only :: Test -> Test
only (Test [SingleTest Expectation]
tests) =
[SingleTest Expectation] -> Test
Test ([SingleTest Expectation] -> Test)
-> [SingleTest Expectation] -> Test
forall a b. (a -> b) -> a -> b
<| (SingleTest Expectation -> SingleTest Expectation)
-> [SingleTest Expectation] -> [SingleTest Expectation]
forall a b. (a -> b) -> List a -> List b
List.map (\SingleTest Expectation
test' -> SingleTest Expectation
test' {label :: Label
label = Label
Only}) [SingleTest Expectation]
tests
run :: Test -> Task e SuiteResult
run :: Test -> Task e SuiteResult
run (Test [SingleTest Expectation]
all) = do
let grouped :: Dict Label [SingleTest Expectation]
grouped = (SingleTest Expectation -> Label)
-> [SingleTest Expectation] -> Dict Label [SingleTest Expectation]
forall key a. Ord key => (a -> key) -> [a] -> Dict key [a]
groupBy SingleTest Expectation -> Label
forall a. SingleTest a -> Label
label [SingleTest Expectation]
all
let skipped :: [SingleTest Expectation]
skipped = Label
-> Dict Label [SingleTest Expectation]
-> Maybe [SingleTest Expectation]
forall comparable v.
Ord comparable =>
comparable -> Dict comparable v -> Maybe v
Dict.get Label
Skip Dict Label [SingleTest Expectation]
grouped Maybe [SingleTest Expectation]
-> (Maybe [SingleTest Expectation] -> [SingleTest Expectation])
-> [SingleTest Expectation]
forall a b. a -> (a -> b) -> b
|> [SingleTest Expectation]
-> Maybe [SingleTest Expectation] -> [SingleTest Expectation]
forall a. a -> Maybe a -> a
Maybe.withDefault []
let todos :: [SingleTest Expectation]
todos = Label
-> Dict Label [SingleTest Expectation]
-> Maybe [SingleTest Expectation]
forall comparable v.
Ord comparable =>
comparable -> Dict comparable v -> Maybe v
Dict.get Label
Todo Dict Label [SingleTest Expectation]
grouped Maybe [SingleTest Expectation]
-> (Maybe [SingleTest Expectation] -> [SingleTest Expectation])
-> [SingleTest Expectation]
forall a b. a -> (a -> b) -> b
|> [SingleTest Expectation]
-> Maybe [SingleTest Expectation] -> [SingleTest Expectation]
forall a. a -> Maybe a -> a
Maybe.withDefault []
let containsOnlys :: Bool
containsOnlys =
case Label
-> Dict Label [SingleTest Expectation]
-> Maybe [SingleTest Expectation]
forall comparable v.
Ord comparable =>
comparable -> Dict comparable v -> Maybe v
Dict.get Label
Only Dict Label [SingleTest Expectation]
grouped Maybe [SingleTest Expectation]
-> (Maybe [SingleTest Expectation] -> [SingleTest Expectation])
-> [SingleTest Expectation]
forall a b. a -> (a -> b) -> b
|> [SingleTest Expectation]
-> Maybe [SingleTest Expectation] -> [SingleTest Expectation]
forall a. a -> Maybe a -> a
Maybe.withDefault [] of
[] -> Bool
False
[SingleTest Expectation]
_ -> Bool
True
let doRun :: Label -> Bool
doRun Label
label =
if Bool
containsOnlys
then Label
label Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
Only
else Label
label Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
None
let ([SingleTest Expectation]
toRun, [SingleTest Expectation]
notToRun') =
Dict Label [SingleTest Expectation]
-> List (Label, [SingleTest Expectation])
forall k v. Dict k v -> List (k, v)
Dict.toList Dict Label [SingleTest Expectation]
grouped
List (Label, [SingleTest Expectation])
-> (List (Label, [SingleTest Expectation])
-> (List (Label, [SingleTest Expectation]),
List (Label, [SingleTest Expectation])))
-> (List (Label, [SingleTest Expectation]),
List (Label, [SingleTest Expectation]))
forall a b. a -> (a -> b) -> b
|> ((Label, [SingleTest Expectation]) -> Bool)
-> List (Label, [SingleTest Expectation])
-> (List (Label, [SingleTest Expectation]),
List (Label, [SingleTest Expectation]))
forall a. (a -> Bool) -> List a -> (List a, List a)
List.partition (Label -> Bool
doRun (Label -> Bool)
-> ((Label, [SingleTest Expectation]) -> Label)
-> (Label, [SingleTest Expectation])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< (Label, [SingleTest Expectation]) -> Label
forall a b. (a, b) -> a
Tuple.first)
(List (Label, [SingleTest Expectation]),
List (Label, [SingleTest Expectation]))
-> ((List (Label, [SingleTest Expectation]),
List (Label, [SingleTest Expectation]))
-> ([SingleTest Expectation], [SingleTest Expectation]))
-> ([SingleTest Expectation], [SingleTest Expectation])
forall a b. a -> (a -> b) -> b
|> (List (Label, [SingleTest Expectation])
-> [SingleTest Expectation])
-> (List (Label, [SingleTest Expectation])
-> [SingleTest Expectation])
-> (List (Label, [SingleTest Expectation]),
List (Label, [SingleTest Expectation]))
-> ([SingleTest Expectation], [SingleTest Expectation])
forall a x b y. (a -> x) -> (b -> y) -> (a, b) -> (x, y)
Tuple.mapBoth (((Label, [SingleTest Expectation]) -> [SingleTest Expectation])
-> List (Label, [SingleTest Expectation])
-> [SingleTest Expectation]
forall a b. (a -> List b) -> List a -> List b
List.concatMap (Label, [SingleTest Expectation]) -> [SingleTest Expectation]
forall a b. (a, b) -> b
Tuple.second) (((Label, [SingleTest Expectation]) -> [SingleTest Expectation])
-> List (Label, [SingleTest Expectation])
-> [SingleTest Expectation]
forall a b. (a -> List b) -> List a -> List b
List.concatMap (Label, [SingleTest Expectation]) -> [SingleTest Expectation]
forall a b. (a, b) -> b
Tuple.second)
let notToRun :: List (SingleTest NotRan)
notToRun = (SingleTest Expectation -> SingleTest NotRan)
-> [SingleTest Expectation] -> List (SingleTest NotRan)
forall a b. (a -> b) -> List a -> List b
List.map (\SingleTest Expectation
test' -> SingleTest Expectation
test' {body :: NotRan
body = NotRan
NotRan}) [SingleTest Expectation]
notToRun'
List (SingleTest (TracingSpan, TestResult))
results <- List (Task e (SingleTest (TracingSpan, TestResult)))
-> Task e (List (SingleTest (TracingSpan, TestResult)))
forall x a. List (Task x a) -> Task x (List a)
Task.parallel ((SingleTest Expectation
-> Task e (SingleTest (TracingSpan, TestResult)))
-> [SingleTest Expectation]
-> List (Task e (SingleTest (TracingSpan, TestResult)))
forall a b. (a -> b) -> List a -> List b
List.map SingleTest Expectation
-> Task e (SingleTest (TracingSpan, TestResult))
forall e.
SingleTest Expectation
-> Task e (SingleTest (TracingSpan, TestResult))
runSingle [SingleTest Expectation]
toRun)
let ([SingleTest (TracingSpan, Failure)]
failed, [SingleTest TracingSpan]
passed) =
List (SingleTest (TracingSpan, TestResult))
results
List (SingleTest (TracingSpan, TestResult))
-> (List (SingleTest (TracingSpan, TestResult))
-> List
(Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan)))
-> List
(Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan))
forall a b. a -> (a -> b) -> b
|> (SingleTest (TracingSpan, TestResult)
-> Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan))
-> List (SingleTest (TracingSpan, TestResult))
-> List
(Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan))
forall a b. (a -> b) -> List a -> List b
List.map
( \SingleTest (TracingSpan, TestResult)
test' ->
case SingleTest (TracingSpan, TestResult) -> (TracingSpan, TestResult)
forall a. SingleTest a -> a
body SingleTest (TracingSpan, TestResult)
test' of
(TracingSpan
tracingSpan, Failed Failure
failure) ->
SingleTest (TracingSpan, Failure)
-> Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan)
forall a b. a -> Either a b
Prelude.Left SingleTest (TracingSpan, TestResult)
test' {body :: (TracingSpan, Failure)
body = (TracingSpan
tracingSpan, Failure
failure)}
(TracingSpan
tracingSpan, TestResult
Succeeded) ->
SingleTest TracingSpan
-> Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan)
forall a b. b -> Either a b
Prelude.Right SingleTest (TracingSpan, TestResult)
test' {body :: TracingSpan
body = TracingSpan
tracingSpan}
)
List
(Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan))
-> (List
(Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan))
-> ([SingleTest (TracingSpan, Failure)], [SingleTest TracingSpan]))
-> ([SingleTest (TracingSpan, Failure)], [SingleTest TracingSpan])
forall a b. a -> (a -> b) -> b
|> List
(Either
(SingleTest (TracingSpan, Failure)) (SingleTest TracingSpan))
-> ([SingleTest (TracingSpan, Failure)], [SingleTest TracingSpan])
forall a b. [Either a b] -> ([a], [b])
Data.Either.partitionEithers
let summary :: Summary
summary =
Summary :: Bool -> Bool -> Bool -> Bool -> Summary
Summary
{ noTests :: Bool
noTests = [SingleTest Expectation] -> Bool
forall a. List a -> Bool
List.isEmpty [SingleTest Expectation]
all,
allPassed :: Bool
allPassed = [SingleTest (TracingSpan, Failure)] -> Bool
forall a. List a -> Bool
List.isEmpty [SingleTest (TracingSpan, Failure)]
failed,
anyOnlys :: Bool
anyOnlys = Bool
containsOnlys,
noneSkipped :: Bool
noneSkipped = [SingleTest Expectation] -> Bool
forall a. List a -> Bool
List.isEmpty ([SingleTest Expectation]
skipped [SingleTest Expectation]
-> [SingleTest Expectation] -> [SingleTest Expectation]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SingleTest Expectation]
todos)
}
SuiteResult -> Task e SuiteResult
forall a x. a -> Task x a
Task.succeed (SuiteResult -> Task e SuiteResult)
-> SuiteResult -> Task e SuiteResult
forall a b. (a -> b) -> a -> b
<| case Summary
summary of
Summary {noTests :: Summary -> Bool
noTests = Bool
True} -> SuiteResult
NoTestsInSuite
Summary {allPassed :: Summary -> Bool
allPassed = Bool
False} -> [SingleTest TracingSpan]
-> List (SingleTest NotRan)
-> [SingleTest (TracingSpan, Failure)]
-> SuiteResult
TestsFailed [SingleTest TracingSpan]
passed List (SingleTest NotRan)
notToRun [SingleTest (TracingSpan, Failure)]
failed
Summary {anyOnlys :: Summary -> Bool
anyOnlys = Bool
True} -> [SingleTest TracingSpan] -> List (SingleTest NotRan) -> SuiteResult
OnlysPassed [SingleTest TracingSpan]
passed List (SingleTest NotRan)
notToRun
Summary {noneSkipped :: Summary -> Bool
noneSkipped = Bool
False} -> [SingleTest TracingSpan] -> List (SingleTest NotRan) -> SuiteResult
PassedWithSkipped [SingleTest TracingSpan]
passed List (SingleTest NotRan)
notToRun
Summary {} -> [SingleTest TracingSpan] -> SuiteResult
AllPassed [SingleTest TracingSpan]
passed
data Summary = Summary
{ Summary -> Bool
noTests :: Bool,
Summary -> Bool
allPassed :: Bool,
Summary -> Bool
anyOnlys :: Bool,
Summary -> Bool
noneSkipped :: Bool
}
handleUnexpectedErrors :: Expectation -> Expectation
handleUnexpectedErrors :: Expectation -> Expectation
handleUnexpectedErrors (Expectation Task Failure ()
task') =
Task Failure ()
task'
Task Failure ()
-> (Task Failure () -> Task Failure ()) -> Task Failure ()
forall a b. a -> (a -> b) -> b
|> (SomeException -> Task Failure ())
-> Task Failure () -> Task Failure ()
forall e a. (SomeException -> Task e a) -> Task e a -> Task e a
onException (Failure -> Task Failure ()
forall x a. x -> Task x a
Task.fail (Failure -> Task Failure ())
-> (SomeException -> Failure) -> SomeException -> Task Failure ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< SomeException -> Failure
ThrewException)
Task Failure ()
-> (Task Failure () -> Task Failure ()) -> Task Failure ()
forall a b. a -> (a -> b) -> b
|> Float -> Failure -> Task Failure () -> Task Failure ()
forall err a. Float -> err -> Task err a -> Task err a
Task.timeout Float
10_000 Failure
TookTooLong
Task Failure ()
-> (Task Failure () -> Task Failure ()) -> Task Failure ()
forall a b. a -> (a -> b) -> b
|> (Failure -> Task Failure ()) -> Task Failure () -> Task Failure ()
forall x y a. (x -> Task y a) -> Task x a -> Task y a
Task.onError Failure -> Task Failure ()
forall x a. x -> Task x a
Task.fail
Task Failure () -> (Task Failure () -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> Task Failure () -> Expectation
forall a. Task Failure a -> Expectation' a
Expectation
runSingle :: SingleTest Expectation -> Task e (SingleTest (TracingSpan, TestResult))
runSingle :: SingleTest Expectation
-> Task e (SingleTest (TracingSpan, TestResult))
runSingle SingleTest Expectation
test' =
(LogHandler
-> IO (Result e (SingleTest (TracingSpan, TestResult))))
-> Task e (SingleTest (TracingSpan, TestResult))
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Platform.Internal.Task
( \LogHandler
_ -> do
MVar TracingSpan
spanVar <- IO (MVar TracingSpan)
forall a. IO (MVar a)
MVar.newEmptyMVar
Result Failure ()
res <-
Text
-> (TracingSpan -> IO ())
-> Text
-> (LogHandler -> IO (Result Failure ()))
-> IO (Result Failure ())
forall a.
HasCallStack =>
Text
-> (TracingSpan -> IO ()) -> Text -> (LogHandler -> IO a) -> IO a
Platform.Internal.rootTracingSpanIO
Text
""
(MVar TracingSpan -> TracingSpan -> IO ()
forall a. MVar a -> a -> IO ()
MVar.putMVar MVar TracingSpan
spanVar)
Text
"test"
( \LogHandler
log ->
SingleTest Expectation -> Expectation
forall a. SingleTest a -> a
body SingleTest Expectation
test'
Expectation -> (Expectation -> Task Failure ()) -> Task Failure ()
forall a b. a -> (a -> b) -> b
|> Expectation -> Task Failure ()
forall a. Expectation' a -> Task Failure a
unExpectation
Task Failure ()
-> (Task Failure () -> Task Failure (Result Failure ()))
-> Task Failure (Result Failure ())
forall a b. a -> (a -> b) -> b
|> (() -> Result Failure ())
-> Task Failure () -> Task Failure (Result Failure ())
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map () -> Result Failure ()
forall error value. value -> Result error value
Ok
Task Failure (Result Failure ())
-> (Task Failure (Result Failure ())
-> Task Never (Result Failure ()))
-> Task Never (Result Failure ())
forall a b. a -> (a -> b) -> b
|> (Failure -> Task Never (Result Failure ()))
-> Task Failure (Result Failure ())
-> Task Never (Result Failure ())
forall x y a. (x -> Task y a) -> Task x a -> Task y a
Task.onError (Result Failure () -> Task Never (Result Failure ())
forall a x. a -> Task x a
Task.succeed (Result Failure () -> Task Never (Result Failure ()))
-> (Failure -> Result Failure ())
-> Failure
-> Task Never (Result Failure ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Failure -> Result Failure ()
forall error value. error -> Result error value
Err)
Task Never (Result Failure ())
-> (Task Never (Result Failure ()) -> IO (Result Failure ()))
-> IO (Result Failure ())
forall a b. a -> (a -> b) -> b
|> LogHandler
-> Task Never (Result Failure ()) -> IO (Result Failure ())
forall a. LogHandler -> Task Never a -> IO a
Task.perform LogHandler
log
)
let testRest :: TestResult
testRest =
case Result Failure ()
res of
Ok () -> TestResult
Succeeded
Err Failure
err -> Failure -> TestResult
Failed Failure
err
TracingSpan
span' <- MVar TracingSpan -> IO TracingSpan
forall a. MVar a -> IO a
MVar.takeMVar MVar TracingSpan
spanVar
let span :: TracingSpan
span =
TracingSpan
span'
{ summary :: Maybe Text
Platform.Internal.summary = Text -> Maybe Text
forall a. a -> Maybe a
Just (SingleTest Expectation -> Text
forall a. SingleTest a -> Text
name SingleTest Expectation
test'),
frame :: Maybe (Text, SrcLoc)
Platform.Internal.frame = (SrcLoc -> (Text, SrcLoc)) -> Maybe SrcLoc -> Maybe (Text, SrcLoc)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\SrcLoc
loc -> (Text
"", SrcLoc
loc)) (SingleTest Expectation -> Maybe SrcLoc
forall a. SingleTest a -> Maybe SrcLoc
loc SingleTest Expectation
test'),
succeeded :: Succeeded
Platform.Internal.succeeded = case TestResult
testRest of
TestResult
Succeeded -> Succeeded
Platform.Internal.Succeeded
Failed Failure
failure ->
Failure -> SomeException
forall e. Exception e => e -> SomeException
Exception.toException Failure
failure
SomeException -> (SomeException -> Succeeded) -> Succeeded
forall a b. a -> (a -> b) -> b
|> SomeException -> Succeeded
Platform.Internal.FailedWith
}
SingleTest Expectation
test' {body :: (TracingSpan, TestResult)
body = (TracingSpan
span, TestResult
testRest)}
SingleTest (TracingSpan, TestResult)
-> (SingleTest (TracingSpan, TestResult)
-> Result e (SingleTest (TracingSpan, TestResult)))
-> Result e (SingleTest (TracingSpan, TestResult))
forall a b. a -> (a -> b) -> b
|> SingleTest (TracingSpan, TestResult)
-> Result e (SingleTest (TracingSpan, TestResult))
forall error value. value -> Result error value
Ok
Result e (SingleTest (TracingSpan, TestResult))
-> (Result e (SingleTest (TracingSpan, TestResult))
-> IO (Result e (SingleTest (TracingSpan, TestResult))))
-> IO (Result e (SingleTest (TracingSpan, TestResult)))
forall a b. a -> (a -> b) -> b
|> Result e (SingleTest (TracingSpan, TestResult))
-> IO (Result e (SingleTest (TracingSpan, TestResult)))
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
)
ioToTask :: Prelude.IO a -> Task Exception.SomeException a
ioToTask :: IO a -> Task SomeException a
ioToTask IO a
io =
(LogHandler -> IO (Result SomeException a)) -> Task SomeException a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Platform.Internal.Task ((LogHandler -> IO (Result SomeException a))
-> Task SomeException a)
-> (LogHandler -> IO (Result SomeException a))
-> Task SomeException a
forall a b. (a -> b) -> a -> b
<| \LogHandler
_ ->
(SomeException -> IO (Result SomeException a))
-> IO (Result SomeException a) -> IO (Result SomeException a)
forall (m :: * -> *) a.
MonadCatch m =>
(SomeException -> m a) -> m a -> m a
Exception.handleAny (Result SomeException a -> IO (Result SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Result SomeException a -> IO (Result SomeException a))
-> (SomeException -> Result SomeException a)
-> SomeException
-> IO (Result SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< SomeException -> Result SomeException a
forall error value. error -> Result error value
Err) ((a -> Result SomeException a)
-> IO a -> IO (Result SomeException a)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map a -> Result SomeException a
forall error value. value -> Result error value
Ok IO a
io)
onException :: (Exception.SomeException -> Task e a) -> Task e a -> Task e a
onException :: (SomeException -> Task e a) -> Task e a -> Task e a
onException SomeException -> Task e a
f (Platform.Internal.Task LogHandler -> IO (Result e a)
run') =
(LogHandler -> IO (Result e a)) -> Task e a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Platform.Internal.Task
( \LogHandler
log ->
LogHandler -> IO (Result e a)
run' LogHandler
log
IO (Result e a)
-> (IO (Result e a) -> IO (Result e a)) -> IO (Result e a)
forall a b. a -> (a -> b) -> b
|> (SomeException -> IO (Result e a))
-> IO (Result e a) -> IO (Result e a)
forall (m :: * -> *) a.
MonadCatch m =>
(SomeException -> m a) -> m a -> m a
Exception.handleAny (LogHandler -> Task e a -> IO (Result e a)
forall x a. LogHandler -> Task x a -> IO (Result x a)
Task.attempt LogHandler
log (Task e a -> IO (Result e a))
-> (SomeException -> Task e a) -> SomeException -> IO (Result e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< SomeException -> Task e a
f)
)
getFrame :: Stack.HasCallStack => Maybe Stack.SrcLoc
getFrame :: Maybe SrcLoc
getFrame =
CallStack
HasCallStack => CallStack
Stack.callStack
CallStack
-> (CallStack -> [(String, SrcLoc)]) -> [(String, SrcLoc)]
forall a b. a -> (a -> b) -> b
|> CallStack -> [(String, SrcLoc)]
Stack.getCallStack
[(String, SrcLoc)]
-> ([(String, SrcLoc)] -> Maybe (String, SrcLoc))
-> Maybe (String, SrcLoc)
forall a b. a -> (a -> b) -> b
|> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. List a -> Maybe a
List.head
Maybe (String, SrcLoc)
-> (Maybe (String, SrcLoc) -> Maybe SrcLoc) -> Maybe SrcLoc
forall a b. a -> (a -> b) -> b
|> ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
Tuple.second
groupBy :: Ord key => (a -> key) -> [a] -> Dict.Dict key [a]
groupBy :: (a -> key) -> [a] -> Dict key [a]
groupBy a -> key
key [a]
xs =
(a -> Dict key [a] -> Dict key [a])
-> Dict key [a] -> [a] -> Dict key [a]
forall a b. (a -> b -> b) -> b -> List a -> b
List.foldr
( \a
x Dict key [a]
acc ->
key -> (Maybe [a] -> Maybe [a]) -> Dict key [a] -> Dict key [a]
forall comparable v.
Ord comparable =>
comparable
-> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v
Dict.update
(a -> key
key a
x)
( \Maybe [a]
val ->
[a] -> Maybe [a]
forall a. a -> Maybe a
Just
([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
<| case Maybe [a]
val of
Maybe [a]
Nothing -> [a
x]
Just [a]
ys -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
)
Dict key [a]
acc
)
Dict key [a]
forall k v. Dict k v
Dict.empty
[a]
xs
append :: Expectation -> Expectation -> Expectation
append :: Expectation -> Expectation -> Expectation
append (Expectation Task Failure ()
task1) (Expectation Task Failure ()
task2) =
Task Failure () -> Expectation
forall a. Task Failure a -> Expectation' a
Expectation (Task Failure () -> Expectation) -> Task Failure () -> Expectation
forall a b. (a -> b) -> a -> b
<| do
Task Failure ()
task1
Task Failure ()
task2
pass :: Stack.HasCallStack => Text -> a -> Expectation' a
pass :: Text -> a -> Expectation' a
pass Text
name a
a = (HasCallStack => Text -> Task Failure a -> Expectation' a)
-> Text -> Task Failure a -> Expectation' a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> Task Failure a -> Expectation' a
forall a. HasCallStack => Text -> Task Failure a -> Expectation' a
traceExpectation Text
name (a -> Task Failure a
forall a x. a -> Task x a
Task.succeed a
a)
failAssertion :: Stack.HasCallStack => Text -> Text -> Expectation' a
failAssertion :: Text -> Text -> Expectation' a
failAssertion Text
name Text
err =
Text -> Maybe SrcLoc -> Failure
FailedAssertion Text
err ((HasCallStack => Maybe SrcLoc) -> Maybe SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Maybe SrcLoc
getFrame)
Failure -> (Failure -> Task Failure a) -> Task Failure a
forall a b. a -> (a -> b) -> b
|> Failure -> Task Failure a
forall x a. x -> Task x a
Task.fail
Task Failure a
-> (Task Failure a -> Expectation' a) -> Expectation' a
forall a b. a -> (a -> b) -> b
|> (HasCallStack => Text -> Task Failure a -> Expectation' a)
-> Text -> Task Failure a -> Expectation' a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> Task Failure a -> Expectation' a
forall a. HasCallStack => Text -> Task Failure a -> Expectation' a
traceExpectation Text
name
traceExpectation :: Stack.HasCallStack => Text -> Task Failure a -> Expectation' a
traceExpectation :: Text -> Task Failure a -> Expectation' a
traceExpectation Text
name Task Failure a
task =
(HasCallStack => Text -> Task Failure a -> Task Failure a)
-> Text -> Task Failure a -> Task Failure a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => Text -> Task Failure a -> Task Failure a
forall e a. HasCallStack => Text -> Task e a -> Task e a
Platform.tracingSpan
Text
name
Task Failure a
task
Task Failure a
-> (Task Failure a -> Expectation' a) -> Expectation' a
forall a b. a -> (a -> b) -> b
|> Task Failure a -> Expectation' a
forall a. Task Failure a -> Expectation' a
Expectation