{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
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.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
| 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]}
newtype Expectation = Expectation {Expectation -> Task Never TestResult
unExpectation :: Task Never TestResult}
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 Never TestResult -> Expectation
Expectation (TestResult -> Task Never TestResult
forall a x. a -> Task x a
Task.succeed TestResult
Succeeded)
}
]
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 =
Task Never TestResult -> Expectation
Expectation
(Task Never TestResult -> Expectation)
-> Task Never TestResult -> Expectation
forall a b. (a -> b) -> a -> b
<| (LogHandler -> IO (Result Never TestResult))
-> Task Never TestResult
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Platform.Internal.Task
( \LogHandler
log -> do
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
TestResult
result <-
a -> Expectation
expectation a
generated
Expectation -> (Expectation -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> Expectation -> Expectation
handleUnexpectedErrors
Expectation
-> (Expectation -> Task Never TestResult) -> Task Never TestResult
forall a b. a -> (a -> b) -> b
|> Expectation -> Task Never TestResult
unExpectation
Task Never TestResult
-> (Task Never TestResult -> IO TestResult) -> IO TestResult
forall a b. a -> (a -> b) -> b
|> LogHandler -> Task Never TestResult -> IO TestResult
forall a. LogHandler -> Task Never a -> IO a
Task.perform LogHandler
log
IO TestResult
-> (IO TestResult -> PropertyT IO TestResult)
-> PropertyT IO TestResult
forall a b. a -> (a -> b) -> b
|> IO TestResult -> PropertyT IO TestResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Control.Monad.IO.Class.liftIO
case TestResult
result of
TestResult
Succeeded -> () -> PropertyT IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()
Failed 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 -> TestResult) -> TestResult
forall a b. a -> (a -> b) -> b
|> Failure -> TestResult
Failed
TestResult
-> (TestResult -> Result Never TestResult)
-> Result Never TestResult
forall a b. a -> (a -> b) -> b
|> TestResult -> Result Never TestResult
forall error value. value -> Result error value
Ok
Result Never TestResult
-> (Result Never TestResult -> IO (Result Never TestResult))
-> IO (Result Never TestResult)
forall a b. a -> (a -> b) -> b
|> Result Never TestResult -> IO (Result Never TestResult)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
Just Failure
failure ->
Failure -> TestResult
Failed Failure
failure
TestResult
-> (TestResult -> Result Never TestResult)
-> Result Never TestResult
forall a b. a -> (a -> b) -> b
|> TestResult -> Result Never TestResult
forall error value. value -> Result error value
Ok
Result Never TestResult
-> (Result Never TestResult -> IO (Result Never TestResult))
-> IO (Result Never TestResult)
forall a b. a -> (a -> b) -> b
|> Result Never TestResult -> IO (Result Never TestResult)
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 -> TestResult) -> TestResult
forall a b. a -> (a -> b) -> b
|> Failure -> TestResult
Failed
TestResult
-> (TestResult -> Result Never TestResult)
-> Result Never TestResult
forall a b. a -> (a -> b) -> b
|> TestResult -> Result Never TestResult
forall error value. value -> Result error value
Ok
Result Never TestResult
-> (Result Never TestResult -> IO (Result Never TestResult))
-> IO (Result Never TestResult)
forall a b. a -> (a -> b) -> b
|> Result Never TestResult -> IO (Result Never TestResult)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
Result
Hedgehog.Internal.Report.OK ->
TestResult -> Result Never TestResult
forall error value. value -> Result error value
Ok TestResult
Succeeded
Result Never TestResult
-> (Result Never TestResult -> IO (Result Never TestResult))
-> IO (Result Never TestResult)
forall a b. a -> (a -> b) -> b
|> Result Never TestResult -> IO (Result Never TestResult)
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
task :: Stack.HasCallStack => Text -> Task Failure a -> Test
task :: Text -> Task Failure a -> Test
task Text
name Task Failure a
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 =
Task Failure a
expectation
Task Failure a
-> (Task Failure a -> Task Failure TestResult)
-> Task Failure TestResult
forall a b. a -> (a -> b) -> b
|> (a -> TestResult) -> Task Failure a -> Task Failure TestResult
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\a
_ -> TestResult
Succeeded)
Task Failure TestResult
-> (Task Failure TestResult -> Task Never TestResult)
-> Task Never TestResult
forall a b. a -> (a -> b) -> b
|> (Failure -> Task Never TestResult)
-> Task Failure TestResult -> Task Never TestResult
forall x y a. (x -> Task y a) -> Task x a -> Task y a
Task.onError (TestResult -> Task Never TestResult
forall a x. a -> Task x a
Task.succeed (TestResult -> Task Never TestResult)
-> (Failure -> TestResult) -> Failure -> Task Never TestResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Failure -> TestResult
Failed)
Task Never TestResult
-> (Task Never TestResult -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> Task Never TestResult -> Expectation
Expectation
Expectation -> (Expectation -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> Expectation -> Expectation
handleUnexpectedErrors
}
]
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 Never TestResult
task') =
Task Never TestResult
task'
Task Never TestResult
-> (Task Never TestResult -> Task Failure TestResult)
-> Task Failure TestResult
forall a b. a -> (a -> b) -> b
|> (Never -> Failure)
-> Task Never TestResult -> Task Failure TestResult
forall x y a. (x -> y) -> Task x a -> Task y a
Task.mapError Never -> Failure
forall a. Never -> a
never
Task Failure TestResult
-> (Task Failure TestResult -> Task Failure TestResult)
-> Task Failure TestResult
forall a b. a -> (a -> b) -> b
|> (SomeException -> Task Failure TestResult)
-> Task Failure TestResult -> Task Failure TestResult
forall e a. (SomeException -> Task e a) -> Task e a -> Task e a
onException (TestResult -> Task Failure TestResult
forall a x. a -> Task x a
Task.succeed (TestResult -> Task Failure TestResult)
-> (Failure -> TestResult) -> Failure -> Task Failure TestResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Failure -> TestResult
Failed (Failure -> Task Failure TestResult)
-> (SomeException -> Failure)
-> SomeException
-> Task Failure TestResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< SomeException -> Failure
ThrewException)
Task Failure TestResult
-> (Task Failure TestResult -> Task Failure TestResult)
-> Task Failure TestResult
forall a b. a -> (a -> b) -> b
|> Float
-> Failure -> Task Failure TestResult -> Task Failure TestResult
forall err a. Float -> err -> Task err a -> Task err a
Task.timeout Float
10_000 Failure
TookTooLong
Task Failure TestResult
-> (Task Failure TestResult -> Task Never TestResult)
-> Task Never TestResult
forall a b. a -> (a -> b) -> b
|> (Failure -> Task Never TestResult)
-> Task Failure TestResult -> Task Never TestResult
forall x y a. (x -> Task y a) -> Task x a -> Task y a
Task.onError (TestResult -> Task Never TestResult
forall a x. a -> Task x a
Task.succeed (TestResult -> Task Never TestResult)
-> (Failure -> TestResult) -> Failure -> Task Never TestResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Failure -> TestResult
Failed)
Task Never TestResult
-> (Task Never TestResult -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> Task Never TestResult -> Expectation
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 Never TestResult
res <-
Text
-> (TracingSpan -> IO ())
-> Text
-> (LogHandler -> IO (Result Never TestResult))
-> IO (Result Never TestResult)
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 Never TestResult) -> Task Never TestResult
forall a b. a -> (a -> b) -> b
|> Expectation -> Task Never TestResult
unExpectation
Task Never TestResult
-> (Task Never TestResult -> Task Never TestResult)
-> Task Never TestResult
forall a b. a -> (a -> b) -> b
|> (Never -> Never) -> Task Never TestResult -> Task Never TestResult
forall x y a. (x -> y) -> Task x a -> Task y a
Task.mapError Never -> Never
forall a. Never -> a
never
Task Never TestResult
-> (Task Never TestResult -> Task Never (Result Never TestResult))
-> Task Never (Result Never TestResult)
forall a b. a -> (a -> b) -> b
|> (TestResult -> Result Never TestResult)
-> Task Never TestResult -> Task Never (Result Never TestResult)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map TestResult -> Result Never TestResult
forall error value. value -> Result error value
Ok
Task Never (Result Never TestResult)
-> (Task Never (Result Never TestResult)
-> IO (Result Never TestResult))
-> IO (Result Never TestResult)
forall a b. a -> (a -> b) -> b
|> LogHandler
-> Task Never (Result Never TestResult)
-> IO (Result Never TestResult)
forall a. LogHandler -> Task Never a -> IO a
Task.perform LogHandler
log
)
let testRest :: TestResult
testRest =
case Result Never TestResult
res of
Ok TestResult
x -> TestResult
x
Err Never
err -> Never -> TestResult
forall a. Never -> a
never Never
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 Never TestResult
task1) (Expectation Task Never TestResult
task2) =
Task Never TestResult
task1
Task Never TestResult
-> (Task Never TestResult -> Task Never TestResult)
-> Task Never TestResult
forall a b. a -> (a -> b) -> b
|> (TestResult -> Task Never TestResult)
-> Task Never TestResult -> Task Never TestResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
andThen
( \TestResult
result1 ->
case TestResult
result1 of
TestResult
Succeeded -> Task Never TestResult
task2
Failed Failure
_ -> Task Never TestResult
task1
)
Task Never TestResult
-> (Task Never TestResult -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> Task Never TestResult -> Expectation
Expectation