{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
-- GHC wants us to remove `Err never` branches from case statements, because it
-- knows we'll never end up in those branches. We like them though, because
-- missing such a branch in a case statement looks like a problem and so is
-- distracting.
{-# 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 Control.Monad (when)
import qualified Control.Monad.IO.Class
import qualified Data.Either
import qualified Data.IORef as IORef
import Data.List (isSuffixOf)
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 Set
import qualified System.Environment
import System.FilePath (FilePath)
import qualified Task
import qualified Text
import Text.Read (readMaybe)
import qualified Tuple
import qualified Prelude

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

data SubsetOfTests = SubsetOfTests {SubsetOfTests -> String
requestedPath :: FilePath, SubsetOfTests -> Maybe Int
lineOfCode :: Maybe Int}
  deriving (SubsetOfTests -> SubsetOfTests -> Bool
(SubsetOfTests -> SubsetOfTests -> Bool)
-> (SubsetOfTests -> SubsetOfTests -> Bool) -> Eq SubsetOfTests
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubsetOfTests -> SubsetOfTests -> Bool
== :: SubsetOfTests -> SubsetOfTests -> Bool
$c/= :: SubsetOfTests -> SubsetOfTests -> Bool
/= :: SubsetOfTests -> SubsetOfTests -> Bool
Eq, Int -> SubsetOfTests -> ShowS
[SubsetOfTests] -> ShowS
SubsetOfTests -> String
(Int -> SubsetOfTests -> ShowS)
-> (SubsetOfTests -> String)
-> ([SubsetOfTests] -> ShowS)
-> Show SubsetOfTests
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubsetOfTests -> ShowS
showsPrec :: Int -> SubsetOfTests -> ShowS
$cshow :: SubsetOfTests -> String
show :: SubsetOfTests -> String
$cshowList :: [SubsetOfTests] -> ShowS
showList :: [SubsetOfTests] -> ShowS
Show)

data SingleTest a = SingleTest
  { forall a. SingleTest a -> [Text]
describes :: [Text],
    forall a. SingleTest a -> Text
name :: Text,
    forall a. SingleTest a -> Label
label :: Label,
    -- This is used for serializing execution of grouped tests (e.g. database tests)
    forall a. SingleTest a -> Group
group :: Group,
    forall a. SingleTest a -> SrcLoc
loc :: Stack.SrcLoc,
    forall a. SingleTest a -> a
body :: a
  }
  deriving (Int -> SingleTest a -> ShowS
[SingleTest a] -> ShowS
SingleTest a -> String
(Int -> SingleTest a -> ShowS)
-> (SingleTest a -> String)
-> ([SingleTest a] -> ShowS)
-> Show (SingleTest a)
forall a. Show a => Int -> SingleTest a -> ShowS
forall a. Show a => [SingleTest a] -> ShowS
forall a. Show a => SingleTest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SingleTest a -> ShowS
showsPrec :: Int -> SingleTest a -> ShowS
$cshow :: forall a. Show a => SingleTest a -> String
show :: SingleTest a -> String
$cshowList :: forall a. Show a => [SingleTest a] -> ShowS
showList :: [SingleTest a] -> ShowS
Show, (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
$cfmap :: forall a b. (a -> b) -> SingleTest a -> SingleTest b
fmap :: forall a b. (a -> b) -> SingleTest a -> SingleTest b
$c<$ :: forall a b. a -> SingleTest b -> SingleTest a
<$ :: forall a b. a -> SingleTest b -> SingleTest a
Prelude.Functor)

data Label = None | Skip | Only | Todo
  deriving (Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Label -> ShowS
showsPrec :: Int -> Label -> ShowS
$cshow :: Label -> String
show :: Label -> String
$cshowList :: [Label] -> ShowS
showList :: [Label] -> ShowS
Show, Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
/= :: 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
$ccompare :: Label -> Label -> Ordering
compare :: Label -> Label -> Ordering
$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
>= :: Label -> Label -> Bool
$cmax :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
min :: Label -> Label -> Label
Ord)

data Group = Grouped (Set.Set GroupKey) | Ungrouped
  deriving (Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Group -> ShowS
showsPrec :: Int -> Group -> ShowS
$cshow :: Group -> String
show :: Group -> String
$cshowList :: [Group] -> ShowS
showList :: [Group] -> ShowS
Show, Group -> Group -> Bool
(Group -> Group -> Bool) -> (Group -> Group -> Bool) -> Eq Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
/= :: Group -> Group -> Bool
Eq, Eq Group
Eq Group =>
(Group -> Group -> Ordering)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Group)
-> (Group -> Group -> Group)
-> Ord Group
Group -> Group -> Bool
Group -> Group -> Ordering
Group -> Group -> Group
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
$ccompare :: Group -> Group -> Ordering
compare :: Group -> Group -> Ordering
$c< :: Group -> Group -> Bool
< :: Group -> Group -> Bool
$c<= :: Group -> Group -> Bool
<= :: Group -> Group -> Bool
$c> :: Group -> Group -> Bool
> :: Group -> Group -> Bool
$c>= :: Group -> Group -> Bool
>= :: Group -> Group -> Bool
$cmax :: Group -> Group -> Group
max :: Group -> Group -> Group
$cmin :: Group -> Group -> Group
min :: Group -> Group -> Group
Ord)

newtype GroupKey = GroupKey {GroupKey -> Text
unGroupkey :: Text}
  deriving (Int -> GroupKey -> ShowS
[GroupKey] -> ShowS
GroupKey -> String
(Int -> GroupKey -> ShowS)
-> (GroupKey -> String) -> ([GroupKey] -> ShowS) -> Show GroupKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupKey -> ShowS
showsPrec :: Int -> GroupKey -> ShowS
$cshow :: GroupKey -> String
show :: GroupKey -> String
$cshowList :: [GroupKey] -> ShowS
showList :: [GroupKey] -> ShowS
Show, GroupKey -> GroupKey -> Bool
(GroupKey -> GroupKey -> Bool)
-> (GroupKey -> GroupKey -> Bool) -> Eq GroupKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupKey -> GroupKey -> Bool
== :: GroupKey -> GroupKey -> Bool
$c/= :: GroupKey -> GroupKey -> Bool
/= :: GroupKey -> GroupKey -> Bool
Eq, Eq GroupKey
Eq GroupKey =>
(GroupKey -> GroupKey -> Ordering)
-> (GroupKey -> GroupKey -> Bool)
-> (GroupKey -> GroupKey -> Bool)
-> (GroupKey -> GroupKey -> Bool)
-> (GroupKey -> GroupKey -> Bool)
-> (GroupKey -> GroupKey -> GroupKey)
-> (GroupKey -> GroupKey -> GroupKey)
-> Ord GroupKey
GroupKey -> GroupKey -> Bool
GroupKey -> GroupKey -> Ordering
GroupKey -> GroupKey -> GroupKey
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
$ccompare :: GroupKey -> GroupKey -> Ordering
compare :: GroupKey -> GroupKey -> Ordering
$c< :: GroupKey -> GroupKey -> Bool
< :: GroupKey -> GroupKey -> Bool
$c<= :: GroupKey -> GroupKey -> Bool
<= :: GroupKey -> GroupKey -> Bool
$c> :: GroupKey -> GroupKey -> Bool
> :: GroupKey -> GroupKey -> Bool
$c>= :: GroupKey -> GroupKey -> Bool
>= :: GroupKey -> GroupKey -> Bool
$cmax :: GroupKey -> GroupKey -> GroupKey
max :: GroupKey -> GroupKey -> GroupKey
$cmin :: GroupKey -> GroupKey -> GroupKey
min :: GroupKey -> GroupKey -> GroupKey
Ord)

data TestResult
  = Succeeded
  | Failed Failure

data Failure
  = FailedAssertion Text 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
$cshowsPrec :: Int -> Failure -> ShowS
showsPrec :: Int -> Failure -> ShowS
$cshow :: Failure -> String
show :: Failure -> String
$cshowList :: [Failure] -> ShowS
showList :: [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 FailedSpan]
  | NoTestsInSuite
  deriving (Int -> SuiteResult -> ShowS
[SuiteResult] -> ShowS
SuiteResult -> String
(Int -> SuiteResult -> ShowS)
-> (SuiteResult -> String)
-> ([SuiteResult] -> ShowS)
-> Show SuiteResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SuiteResult -> ShowS
showsPrec :: Int -> SuiteResult -> ShowS
$cshow :: SuiteResult -> String
show :: SuiteResult -> String
$cshowList :: [SuiteResult] -> ShowS
showList :: [SuiteResult] -> ShowS
Show)

data NotRan = NotRan
  deriving (Int -> NotRan -> ShowS
[NotRan] -> ShowS
NotRan -> String
(Int -> NotRan -> ShowS)
-> (NotRan -> String) -> ([NotRan] -> ShowS) -> Show NotRan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotRan -> ShowS
showsPrec :: Int -> NotRan -> ShowS
$cshow :: NotRan -> String
show :: NotRan -> String
$cshowList :: [NotRan] -> ShowS
showList :: [NotRan] -> ShowS
Show)

data FailedSpan = FailedSpan TracingSpan Failure

instance Show FailedSpan where
  show :: FailedSpan -> String
show (FailedSpan TracingSpan
span Failure
failure) = Failure -> String
forall a. Show a => a -> String
Prelude.show Failure
failure String -> ShowS
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ String
": " String -> ShowS
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ TracingSpan -> String
forall a. Show a => a -> String
Prelude.show TracingSpan
span

-- | A test which has yet to be evaluated. When evaluated, it produces one
-- or more 'Expect.Expectation's.
-- See 'test' and 'fuzz' for some ways to create a @Test@.
newtype Test = Test {Test -> [SingleTest Expectation]
unTest :: [SingleTest Expectation]}

-- | The result of a single test run: either a 'pass' or a 'fail'.
type Expectation = Expectation' ()

-- | The type of a test that runs some script with multiple expectations in
-- between.
newtype Expectation' a = Expectation {forall a. Expectation' a -> Task Failure a
unExpectation :: Task Failure a}
  deriving ((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
$cfmap :: forall a b. (a -> b) -> Expectation' a -> Expectation' b
fmap :: forall a b. (a -> b) -> Expectation' a -> Expectation' b
$c<$ :: forall a b. a -> Expectation' b -> Expectation' a
<$ :: forall a b. a -> Expectation' b -> Expectation' a
Prelude.Functor, Functor Expectation'
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'
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
$cpure :: forall a. a -> Expectation' a
pure :: forall a. a -> Expectation' a
$c<*> :: forall a b.
Expectation' (a -> b) -> Expectation' a -> Expectation' b
<*> :: forall a b.
Expectation' (a -> b) -> Expectation' a -> Expectation' b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Expectation' a -> Expectation' b -> Expectation' c
liftA2 :: forall a b c.
(a -> b -> c) -> Expectation' a -> Expectation' b -> Expectation' c
$c*> :: forall a b. Expectation' a -> Expectation' b -> Expectation' b
*> :: forall a b. Expectation' a -> Expectation' b -> Expectation' b
$c<* :: forall a b. Expectation' a -> Expectation' b -> Expectation' a
<* :: forall a b. Expectation' a -> Expectation' b -> Expectation' a
Prelude.Applicative, Applicative Expectation'
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'
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
$c>>= :: forall a b.
Expectation' a -> (a -> Expectation' b) -> Expectation' b
>>= :: forall a b.
Expectation' a -> (a -> Expectation' b) -> Expectation' b
$c>> :: forall a b. Expectation' a -> Expectation' b -> Expectation' b
>> :: forall a b. Expectation' a -> Expectation' b -> Expectation' b
$creturn :: forall a. a -> Expectation' a
return :: forall a. a -> Expectation' a
Prelude.Monad)

-- | A @Fuzzer a@ knows how to produce random values of @a@ and how to "shrink"
-- a value of @a@, that is turn a value into another that is slightly simpler.
newtype Fuzzer a = Fuzzer {forall a. Fuzzer a -> Gen a
unFuzzer :: Hedgehog.Gen a}
  deriving ((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
$cfmap :: forall a b. (a -> b) -> Fuzzer a -> Fuzzer b
fmap :: forall a b. (a -> b) -> Fuzzer a -> Fuzzer b
$c<$ :: forall a b. a -> Fuzzer b -> Fuzzer a
<$ :: forall a b. a -> Fuzzer b -> Fuzzer a
Prelude.Functor, Functor Fuzzer
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
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
$cpure :: forall a. a -> Fuzzer a
pure :: forall a. a -> Fuzzer a
$c<*> :: forall a b. Fuzzer (a -> b) -> Fuzzer a -> Fuzzer b
<*> :: forall a b. Fuzzer (a -> b) -> Fuzzer a -> Fuzzer b
$cliftA2 :: forall a b c. (a -> b -> c) -> Fuzzer a -> Fuzzer b -> Fuzzer c
liftA2 :: forall a b c. (a -> b -> c) -> Fuzzer a -> Fuzzer b -> Fuzzer c
$c*> :: forall a b. Fuzzer a -> Fuzzer b -> Fuzzer b
*> :: forall a b. Fuzzer a -> Fuzzer b -> Fuzzer b
$c<* :: forall a b. Fuzzer a -> Fuzzer b -> Fuzzer a
<* :: forall a b. Fuzzer a -> Fuzzer b -> Fuzzer a
Prelude.Applicative)

-- | Apply a description to a list of tests.
--
-- > import Test (describe, test, fuzz)
-- > import Fuzz (int)
-- > import Expect
-- >
-- > describe "List"
-- >     [ describe "reverse"
-- >         [ test "has no effect on an empty list" <|
-- >             \_ ->
-- >                 List.reverse []
-- >                     |> Expect.equal []
-- >         , fuzz int "has no effect on a one-item list" <|
-- >             \num ->
-- >                  List.reverse [ num ]
-- >                     |> Expect.equal [ num ]
-- >         ]
-- >     ]
--
-- Passing an empty list will result in a failing test, because you either made a
-- mistake or are creating a placeholder.
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 = description : describes test'})
    [SingleTest Expectation]
-> ([SingleTest Expectation] -> Test) -> Test
forall a b. a -> (a -> b) -> b
|> [SingleTest Expectation] -> Test
Test

-- | Returns a 'Test' that is "todo" (not yet implemented). These tests always
-- fail.
--
-- These tests aren't meant to be committed to version control. Instead, use
-- them when you're brainstorming lots of tests you'd like to write, but you
-- can't implement them all at once. When you replace @todo@ with a real test,
-- you'll be able to see if it fails without clutter from tests still not
-- implemented. But, unlike leaving yourself comments, you'll be prompted to
-- implement these tests because your suite will fail.
--
-- > describe "a new thing"
-- >     [ todo "does what is expected in the common case"
-- >     , todo "correctly handles an edge case I just thought of"
-- >     ]
--
-- This functionality is similar to "pending" tests in other frameworks, except
-- that a todo test is considered failing but a pending test often is not.
todo :: (Stack.HasCallStack) => Text -> Test
todo :: HasCallStack => Text -> Test
todo Text
name =
  [SingleTest Expectation] -> Test
Test
    [ SingleTest
        { describes :: [Text]
describes = [],
          name :: Text
name = Text
name,
          loc :: SrcLoc
loc = (HasCallStack => Text -> SrcLoc) -> Text -> SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> SrcLoc
Text -> SrcLoc
getFrame Text
name,
          group :: Group
group = Group
Ungrouped,
          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 ())
        }
    ]

-- | Return a 'Test' that evaluates a single
-- 'Expect.Expectation'
--
-- > import Test (fuzz)
-- > import Expect
-- > test "the empty list has 0 length" <|
-- >     \_ ->
-- >         List.length []
-- >             |> Expect.equal 0
test :: (Stack.HasCallStack) => Text -> (() -> Expectation) -> Test
test :: HasCallStack => Text -> (() -> Expectation) -> Test
test Text
name () -> Expectation
expectation =
  [SingleTest Expectation] -> Test
Test
    [ SingleTest
        { describes :: [Text]
describes = [],
          name :: Text
name = Text
name,
          loc :: SrcLoc
loc = (HasCallStack => Text -> SrcLoc) -> Text -> SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> SrcLoc
Text -> SrcLoc
getFrame Text
name,
          group :: Group
group = Group
Ungrouped,
          label :: Label
label = Label
None,
          body :: Expectation
body = Expectation -> Expectation
handleUnexpectedErrors (() -> Expectation
expectation ())
        }
    ]

-- | Serializes the execution of 'Test' based on a certain grouping
--
-- > serialize "mysql" <| todo "some db stuff!"
serialize :: Text -> Test -> Test
serialize :: Text -> Test -> Test
serialize Text
groupKey (Test [SingleTest Expectation]
tests) =
  [SingleTest Expectation]
tests
    [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
singleTest ->
          let groupKeys :: Set GroupKey
groupKeys = case SingleTest Expectation -> Group
forall a. SingleTest a -> Group
group SingleTest Expectation
singleTest of
                Group
Ungrouped -> Set GroupKey
forall a. Set a
Set.empty
                Grouped Set GroupKey
keys -> Set GroupKey
keys
           in SingleTest Expectation
singleTest {group = Grouped (Set.insert (GroupKey groupKey) groupKeys)}
      )
    [SingleTest Expectation]
-> ([SingleTest Expectation] -> Test) -> Test
forall a b. a -> (a -> b) -> b
|> [SingleTest Expectation] -> Test
Test

-- | Take a function that produces a test, and calls it several (usually 100)
-- times, using a randomly-generated input from a 'Fuzzer' each time. This
-- allows you to test that a property that should always be true is indeed true
-- under a wide variety of conditions. The function also takes a string
-- describing the test.
--
-- These are called "fuzz tests" because of the randomness. You may find them
-- elsewhere called property-based tests, generative tests, or QuickCheck-style
-- tests.
fuzz :: (Stack.HasCallStack, Show a) => Fuzzer a -> Text -> (a -> Expectation) -> Test
fuzz :: forall a.
(HasCallStack, Show a) =>
Fuzzer a -> Text -> (a -> Expectation) -> Test
fuzz Fuzzer a
fuzzer Text
name a -> Expectation
expectation =
  [SingleTest Expectation] -> Test
Test
    [ SingleTest
        { describes :: [Text]
describes = [],
          name :: Text
name = Text
name,
          loc :: SrcLoc
loc = (HasCallStack => Text -> SrcLoc) -> Text -> SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> SrcLoc
Text -> SrcLoc
getFrame Text
name,
          group :: Group
group = Group
Ungrouped,
          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
        }
    ]

-- | Run a fuzz test using two random inputs.
fuzz2 :: (Stack.HasCallStack, Show a, Show b) => Fuzzer a -> Fuzzer b -> Text -> (a -> b -> Expectation) -> Test
fuzz2 :: forall a b.
(HasCallStack, Show a, Show b) =>
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
        { describes :: [Text]
describes = [],
          name :: Text
name = Text
name,
          loc :: SrcLoc
loc = (HasCallStack => Text -> SrcLoc) -> Text -> SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> SrcLoc
Text -> SrcLoc
getFrame Text
name,
          group :: Group
group = Group
Ungrouped,
          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)
        }
    ]

-- | Run a fuzz test using three random inputs.
fuzz3 :: (Stack.HasCallStack, Show a, Show b, Show c) => Fuzzer a -> Fuzzer b -> Fuzzer c -> Text -> (a -> b -> c -> Expectation) -> Test
fuzz3 :: forall a b c.
(HasCallStack, Show a, Show b, Show c) =>
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
        { describes :: [Text]
describes = [],
          name :: Text
name = Text
name,
          loc :: SrcLoc
loc = (HasCallStack => Text -> SrcLoc) -> Text -> SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> SrcLoc
Text -> SrcLoc
getFrame Text
name,
          group :: Group
group = Group
Ungrouped,
          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 :: forall a. Show a => 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
          -- For the moment we're not recording traces in fuzz tests. Because
          -- the test body runs a great many times, we'd record a ton of data
          -- that's not all that useful.
          --
          -- Ideally we'd only keep the recording of the most significant run,
          -- but we have to figure out how to do that first.
          silentLog <- IO LogHandler
Platform.silentHandler
          seed <- Hedgehog.Internal.Seed.random
          failureRef <- IORef.newIORef Nothing
          hedgehogResult <-
            Hedgehog.Internal.Runner.checkReport
              Hedgehog.Internal.Property.defaultConfig
              0 -- Same value used as in Hedgehog internals.
              seed
              ( do
                  generated <- Hedgehog.forAll gen
                  result <-
                    expectation generated
                      |> handleUnexpectedErrors
                      |> unExpectation
                      |> Task.map Ok
                      |> Task.onError (Task.succeed << Err)
                      |> Task.perform silentLog
                      |> Control.Monad.IO.Class.liftIO
                  case result of
                    Ok () -> () -> PropertyT IO ()
forall a. a -> PropertyT IO a
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 a. IO a -> PropertyT IO a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ())
          case Hedgehog.Internal.Report.reportStatus hedgehogResult of
            Hedgehog.Internal.Report.Failed FailureReport
_ -> do
              maybeFailure <- IORef (Maybe Failure) -> IO (Maybe Failure)
forall a. IORef a -> IO a
IORef.readIORef IORef (Maybe Failure)
failureRef
              case 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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
      )

-- | Returns a 'Test' that gets skipped.
--
-- Calls to @skip@ aren't meant to be committed to version control. Instead,
-- use it when you want to focus on getting a particular subset of your tests
-- to pass. If you use @skip@, your entire test suite will fail, even if each
-- of the individual tests pass. This is to help avoid accidentally committing
-- a @skip@ to version control.
--
-- See also 'only'. Note that @skip@ takes precedence over @only@; if you use a
-- @skip@ inside an @only@, it will still get skipped, and if you use an @only@
-- inside a @skip@, it will also get skipped.
--
-- > describe "List"
-- >     [ skip <|
-- >         describe "reverse"
-- >             [ test "has no effect on an empty list" <|
-- >                 \_ ->
-- >                     List.reverse []
-- >                         |> Expect.equal []
-- >             , fuzz int "has no effect on a one-item list" <|
-- >                 \num ->
-- >                     List.reverse [ num ]
-- >                         |> Expect.equal [ num ]
-- >             ]
-- >     , test "This is the only test that will get run; the other was skipped!" <|
-- >         \_ ->
-- >             List.length []
-- >                 |> Expect.equal 0
-- >     ]
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 = Skip}) [SingleTest Expectation]
tests

-- | Returns a 'Test' that causes other tests to be skipped, and only runs the given one.
--
-- Calls to @only@ aren't meant to be committed to version control. Instead,
-- use them when you want to focus on getting a particular subset of your tests
-- to pass.  If you use @only@, your entire test suite will fail, even if each
-- of the individual tests pass. This is to help avoid accidentally committing
-- a @only@ to version control.
--
-- If you you use @only@ on multiple tests, only those tests will run. If you
-- put a @only@ inside another @only@, only the outermost @only@ will affect
-- which tests gets run. See also 'skip'. Note that @skip@ takes precedence
-- over @only@; if you use a @skip@ inside an @only@, it will still get
-- skipped, and if you use an @only@ inside a @skip@, it will also get skipped.
--
-- > describe "List"
-- >     [ only <|
-- >         describe "reverse"
-- >             [ test "has no effect on an empty list" <|
-- >                 \_ ->
-- >                     List.reverse []
-- >                         |> Expect.equal []
-- >             , fuzz int "has no effect on a one-item list" <|
-- >                 \num ->
-- >                     List.reverse [ num ]
-- >                         |> Expect.equal [ num ]
-- >             ]
-- >     , test "This will not get run, because of the @only@ above!" <|
-- >         \_ ->
-- >             List.length []
-- >                 |> Expect.equal 0
-- >     ]
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 = Only}) [SingleTest Expectation]
tests

-- | Convert an IO type to an expectation. Useful if you need to call a function
-- in Haskell's base library or an external library in a test.
fromIO :: Prelude.IO a -> Expectation' a
fromIO :: forall a. IO a -> Expectation' a
fromIO IO a
io =
  (LogHandler -> IO (Result Failure a)) -> Task Failure a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Platform.Internal.Task (\LogHandler
_ -> (a -> Result Failure a) -> IO a -> IO (Result Failure a)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map a -> Result Failure a
forall error value. value -> Result error value
Ok IO a
io)
    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

-- | Run an expectation directly in IO.
-- Some external testing libraries required using a resource in an IO continution like `(\resource -> IO a) -> IO a`.
-- For example see warp's `testWithApplication`.
--
-- This function allows you to convert an expectation to IO inside of such a continuation.  You will likely want to
-- transform the result back to an expectation with `fromIOResult`.
runExpectation :: Platform.LogHandler -> Expectation' a -> Prelude.IO (Result Failure a)
runExpectation :: forall a. LogHandler -> Expectation' a -> IO (Result Failure a)
runExpectation LogHandler
log Expectation' a
expectation = do
  Expectation' a -> Task Failure a
forall a. Expectation' a -> Task Failure a
unExpectation Expectation' a
expectation
    Task Failure a
-> (Task Failure a -> IO (Result Failure a))
-> IO (Result Failure a)
forall a b. a -> (a -> b) -> b
|> LogHandler -> Task Failure a -> IO (Result Failure a)
forall x a. LogHandler -> Task x a -> IO (Result x a)
Task.attempt LogHandler
log

-- | Convert an IO action that returns a Result into an expectation.
-- Useful in combination with 'runExpectation'.
fromIOResult :: Prelude.IO (Result Failure a) -> Expectation' a
fromIOResult :: forall a. IO (Result Failure a) -> Expectation' a
fromIOResult IO (Result Failure a)
io =
  (LogHandler -> IO (Result Failure a)) -> Task Failure a
forall x a. (LogHandler -> IO (Result x a)) -> Task x a
Platform.Internal.Task (\LogHandler
_ -> IO (Result Failure a)
io)
    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

run :: Request -> Test -> Task e SuiteResult
run :: forall e. Request -> Test -> Task e SuiteResult
run Request
request (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 :: [SingleTest NotRan]
notToRun = (SingleTest Expectation -> SingleTest NotRan)
-> [SingleTest Expectation] -> [SingleTest NotRan]
forall a b. (a -> b) -> List a -> List b
List.map (\SingleTest Expectation
test' -> SingleTest Expectation
test' {body = NotRan}) [SingleTest Expectation]
notToRun'
  results <-
    ( case Request
request of
        Request
All -> [SingleTest Expectation]
toRun
        Some [SubsetOfTests]
tests -> (SingleTest Expectation -> Bool)
-> [SingleTest Expectation] -> [SingleTest Expectation]
forall a. (a -> Bool) -> List a -> List a
List.filter ([SubsetOfTests] -> SingleTest Expectation -> Bool
forall expectation.
[SubsetOfTests] -> SingleTest expectation -> Bool
subset [SubsetOfTests]
tests) [SingleTest Expectation]
toRun
      )
      [SingleTest Expectation]
-> ([SingleTest Expectation]
    -> Dict RunStrategy [SingleTest Expectation])
-> Dict RunStrategy [SingleTest Expectation]
forall a b. a -> (a -> b) -> b
|> (SingleTest Expectation -> RunStrategy)
-> [SingleTest Expectation]
-> Dict RunStrategy [SingleTest Expectation]
forall key a. Ord key => (a -> key) -> [a] -> Dict key [a]
groupBy SingleTest Expectation -> RunStrategy
forall exp. SingleTest exp -> RunStrategy
runStrategy
      Dict RunStrategy [SingleTest Expectation]
-> (Dict RunStrategy [SingleTest Expectation]
    -> List (RunStrategy, [SingleTest Expectation]))
-> List (RunStrategy, [SingleTest Expectation])
forall a b. a -> (a -> b) -> b
|> Dict RunStrategy [SingleTest Expectation]
-> List (RunStrategy, [SingleTest Expectation])
forall k v. Dict k v -> List (k, v)
Dict.toList
      List (RunStrategy, [SingleTest Expectation])
-> (List (RunStrategy, [SingleTest Expectation])
    -> List (Task e (List (SingleTest (TracingSpan, TestResult)))))
-> List (Task e (List (SingleTest (TracingSpan, TestResult))))
forall a b. a -> (a -> b) -> b
|> ((RunStrategy, [SingleTest Expectation])
 -> Task e (List (SingleTest (TracingSpan, TestResult))))
-> List (RunStrategy, [SingleTest Expectation])
-> List (Task e (List (SingleTest (TracingSpan, TestResult))))
forall a b. (a -> b) -> List a -> List b
List.map (RunStrategy, [SingleTest Expectation])
-> Task e (List (SingleTest (TracingSpan, TestResult)))
forall e.
(RunStrategy, [SingleTest Expectation])
-> Task e (List (SingleTest (TracingSpan, TestResult)))
runGroup
      List (Task e (List (SingleTest (TracingSpan, TestResult))))
-> (List (Task e (List (SingleTest (TracingSpan, TestResult))))
    -> Task e (List (List (SingleTest (TracingSpan, TestResult)))))
-> Task e (List (List (SingleTest (TracingSpan, TestResult))))
forall a b. a -> (a -> b) -> b
|> List (Task e (List (SingleTest (TracingSpan, TestResult))))
-> Task e (List (List (SingleTest (TracingSpan, TestResult))))
forall x a. List (Task x a) -> Task x (List a)
Task.parallel
      Task e (List (List (SingleTest (TracingSpan, TestResult))))
-> (Task e (List (List (SingleTest (TracingSpan, TestResult))))
    -> Task e (List (SingleTest (TracingSpan, TestResult))))
-> Task e (List (SingleTest (TracingSpan, TestResult)))
forall a b. a -> (a -> b) -> b
|> (List (List (SingleTest (TracingSpan, TestResult)))
 -> List (SingleTest (TracingSpan, TestResult)))
-> Task e (List (List (SingleTest (TracingSpan, TestResult))))
-> Task e (List (SingleTest (TracingSpan, TestResult)))
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map List (List (SingleTest (TracingSpan, TestResult)))
-> List (SingleTest (TracingSpan, TestResult))
forall a. List (List a) -> List a
List.concat
  let (failed, passed) =
        results
          |> 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 FailedSpan
-> Either (SingleTest FailedSpan) (SingleTest TracingSpan)
forall a b. a -> Either a b
Prelude.Left SingleTest (TracingSpan, TestResult)
test' {body = FailedSpan tracingSpan failure}
                  (TracingSpan
tracingSpan, TestResult
Succeeded) ->
                    SingleTest TracingSpan
-> Either (SingleTest FailedSpan) (SingleTest TracingSpan)
forall a b. b -> Either a b
Prelude.Right SingleTest (TracingSpan, TestResult)
test' {body = tracingSpan}
            )
          |> Data.Either.partitionEithers
  let summary =
        Summary
          { noTests :: Bool
noTests = [SingleTest Expectation] -> Bool
forall a. List a -> Bool
List.isEmpty [SingleTest Expectation]
all,
            allPassed :: Bool
allPassed = [SingleTest FailedSpan] -> Bool
forall a. List a -> Bool
List.isEmpty [SingleTest FailedSpan]
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)
          }
  Task.succeed <| case summary of
    Summary {noTests :: Summary -> Bool
noTests = Bool
True} -> SuiteResult
NoTestsInSuite
    Summary {allPassed :: Summary -> Bool
allPassed = Bool
False} -> [SingleTest TracingSpan]
-> [SingleTest NotRan] -> [SingleTest FailedSpan] -> SuiteResult
TestsFailed [SingleTest TracingSpan]
passed [SingleTest NotRan]
notToRun [SingleTest FailedSpan]
failed
    Summary {anyOnlys :: Summary -> Bool
anyOnlys = Bool
True} -> [SingleTest TracingSpan] -> [SingleTest NotRan] -> SuiteResult
OnlysPassed [SingleTest TracingSpan]
passed [SingleTest NotRan]
notToRun
    Summary {noneSkipped :: Summary -> Bool
noneSkipped = Bool
False} -> [SingleTest TracingSpan] -> [SingleTest NotRan] -> SuiteResult
PassedWithSkipped [SingleTest TracingSpan]
passed [SingleTest NotRan]
notToRun
    Summary {} -> [SingleTest TracingSpan] -> SuiteResult
AllPassed [SingleTest TracingSpan]
passed

data RunStrategy = Parallel | Sequence deriving (RunStrategy -> RunStrategy -> Bool
(RunStrategy -> RunStrategy -> Bool)
-> (RunStrategy -> RunStrategy -> Bool) -> Eq RunStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStrategy -> RunStrategy -> Bool
== :: RunStrategy -> RunStrategy -> Bool
$c/= :: RunStrategy -> RunStrategy -> Bool
/= :: RunStrategy -> RunStrategy -> Bool
Eq, Eq RunStrategy
Eq RunStrategy =>
(RunStrategy -> RunStrategy -> Ordering)
-> (RunStrategy -> RunStrategy -> Bool)
-> (RunStrategy -> RunStrategy -> Bool)
-> (RunStrategy -> RunStrategy -> Bool)
-> (RunStrategy -> RunStrategy -> Bool)
-> (RunStrategy -> RunStrategy -> RunStrategy)
-> (RunStrategy -> RunStrategy -> RunStrategy)
-> Ord RunStrategy
RunStrategy -> RunStrategy -> Bool
RunStrategy -> RunStrategy -> Ordering
RunStrategy -> RunStrategy -> RunStrategy
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
$ccompare :: RunStrategy -> RunStrategy -> Ordering
compare :: RunStrategy -> RunStrategy -> Ordering
$c< :: RunStrategy -> RunStrategy -> Bool
< :: RunStrategy -> RunStrategy -> Bool
$c<= :: RunStrategy -> RunStrategy -> Bool
<= :: RunStrategy -> RunStrategy -> Bool
$c> :: RunStrategy -> RunStrategy -> Bool
> :: RunStrategy -> RunStrategy -> Bool
$c>= :: RunStrategy -> RunStrategy -> Bool
>= :: RunStrategy -> RunStrategy -> Bool
$cmax :: RunStrategy -> RunStrategy -> RunStrategy
max :: RunStrategy -> RunStrategy -> RunStrategy
$cmin :: RunStrategy -> RunStrategy -> RunStrategy
min :: RunStrategy -> RunStrategy -> RunStrategy
Ord)

runStrategy :: SingleTest exp -> RunStrategy
runStrategy :: forall exp. SingleTest exp -> RunStrategy
runStrategy SingleTest exp
singleTest =
  case SingleTest exp -> Group
forall a. SingleTest a -> Group
group SingleTest exp
singleTest of
    Grouped Set GroupKey
_ -> RunStrategy
Sequence
    Group
Ungrouped -> RunStrategy
Parallel

subset :: List SubsetOfTests -> SingleTest expectation -> Bool
subset :: forall expectation.
[SubsetOfTests] -> SingleTest expectation -> Bool
subset [SubsetOfTests]
subsets SingleTest expectation
singleTest =
  case ([SubsetOfTests]
subsets, SingleTest expectation -> SrcLoc
forall a. SingleTest a -> SrcLoc
loc SingleTest expectation
singleTest) of
    ([], SrcLoc
_) -> Bool
False -- Should never happen, we should have a NonEmpty SubsetOfTests tbh
    (SubsetOfTests {String
requestedPath :: SubsetOfTests -> String
requestedPath :: String
requestedPath, Maybe Int
lineOfCode :: SubsetOfTests -> Maybe Int
lineOfCode :: Maybe Int
lineOfCode} : [SubsetOfTests]
rest, Stack.SrcLoc {String
srcLocFile :: String
srcLocFile :: SrcLoc -> String
Stack.srcLocFile, Int
srcLocStartLine :: Int
srcLocStartLine :: SrcLoc -> Int
Stack.srcLocStartLine, Int
srcLocEndLine :: Int
srcLocEndLine :: SrcLoc -> Int
Stack.srcLocEndLine}) ->
      -- isSuffixOf allows us to write --files=quiz-engine-http/spec/Smth/DerpSpec.hs
      if String
srcLocFile String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
requestedPath
        then case Maybe Int
lineOfCode of
          Maybe Int
Nothing -> Bool
True
          Just Int
requestedLoc' ->
            let requestedLoc :: Int
requestedLoc = Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
requestedLoc'
             in if Int
srcLocStartLine Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
<= Int
requestedLoc Bool -> Bool -> Bool
&& Int
requestedLoc Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
<= Int
srcLocEndLine
                  then Bool
True
                  else [SubsetOfTests] -> SingleTest expectation -> Bool
forall expectation.
[SubsetOfTests] -> SingleTest expectation -> Bool
subset [SubsetOfTests]
rest SingleTest expectation
singleTest
        else [SubsetOfTests] -> SingleTest expectation -> Bool
forall expectation.
[SubsetOfTests] -> SingleTest expectation -> Bool
subset [SubsetOfTests]
rest SingleTest expectation
singleTest

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') = do
  timeout <- Double -> Expectation' Double
timeoutFromEnvOrDefault Double
10_000
  task'
    |> onException (Task.fail << ThrewException)
    |> Task.timeout timeout TookTooLong
    |> Task.onError Task.fail
    |> Expectation

timeoutFromEnvOrDefault :: Prelude.Double -> Expectation' Prelude.Double
timeoutFromEnvOrDefault :: Double -> Expectation' Double
timeoutFromEnvOrDefault Double
defaultTimeout = do
  timeoutFromEnv <- IO (Maybe String) -> Expectation' (Maybe String)
forall a. IO a -> Expectation' a
fromIO (IO (Maybe String) -> Expectation' (Maybe String))
-> IO (Maybe String) -> Expectation' (Maybe String)
forall a b. (a -> b) -> a -> b
<| String -> IO (Maybe String)
System.Environment.lookupEnv String
"NRI_TEST_TIMEOUT"
  case Maybe.andThen readMaybe timeoutFromEnv of
    Just Double
timeout -> Double -> Expectation' Double
forall a. a -> Expectation' a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Double
timeout
    Maybe Double
Nothing -> Double -> Expectation' Double
forall a. a -> Expectation' a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Double
defaultTimeout

runGroup :: (RunStrategy, List (SingleTest Expectation)) -> Task e (List (SingleTest (TracingSpan, TestResult)))
runGroup :: forall e.
(RunStrategy, [SingleTest Expectation])
-> Task e (List (SingleTest (TracingSpan, TestResult)))
runGroup (RunStrategy
groupped, [SingleTest Expectation]
tests) =
  (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]
tests
    List (Task e (SingleTest (TracingSpan, TestResult)))
-> (List (Task e (SingleTest (TracingSpan, TestResult)))
    -> Task e (List (SingleTest (TracingSpan, TestResult))))
-> Task e (List (SingleTest (TracingSpan, TestResult)))
forall a b. a -> (a -> b) -> b
|> ( case RunStrategy
groupped of
           RunStrategy
Sequence -> List (Task e (SingleTest (TracingSpan, TestResult)))
-> Task e (List (SingleTest (TracingSpan, TestResult)))
forall x a. List (Task x a) -> Task x (List a)
Task.sequence
           RunStrategy
Parallel -> 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
       )

runSingle :: SingleTest Expectation -> Task e (SingleTest (TracingSpan, TestResult))
runSingle :: forall e.
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
        spanVar <- IO (MVar TracingSpan)
forall a. IO (MVar a)
MVar.newEmptyMVar
        -- Here we use the source location as the span name so that we can
        -- easily wait for the correct span to be reported.
        -- Other spans might be reported, for example, if the test uses `Platform.newRoot`,
        -- but those spans should be ignored.
        let spanName = String -> Text
Text.fromList (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
<| SrcLoc -> String
Stack.prettySrcLoc (SingleTest Expectation -> SrcLoc
forall a. SingleTest a -> SrcLoc
loc SingleTest Expectation
test')
        res <-
          Platform.Internal.rootTracingSpanIO
            ""
            Platform.Internal.silentTrack
            ( \TracingSpan
span -> do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TracingSpan -> Text
Platform.Internal.name TracingSpan
span Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
spanName) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
<|
                  MVar TracingSpan -> TracingSpan -> IO ()
forall a. MVar a -> a -> IO ()
MVar.putMVar MVar TracingSpan
spanVar TracingSpan
span
            )
            spanName
            ( \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 =
              case Result Failure ()
res of
                Ok () -> TestResult
Succeeded
                -- If you remove this branch, consider also removing the
                -- -fno-warn-overlapping-patterns warning above.
                Err Failure
err -> Failure -> TestResult
Failed Failure
err
        span' <- MVar.takeMVar spanVar
        let span =
              TracingSpan
span'
                { Platform.Internal.name = "test",
                  Platform.Internal.summary = Just (name test'),
                  Platform.Internal.frame = Just ("", loc test'),
                  Platform.Internal.succeeded = case 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
                }
        test' {body = (span, testRest)}
          |> Ok
          |> Prelude.pure
    )

ioToTask :: Prelude.IO a -> Task Exception.SomeException a
ioToTask :: forall a. 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.
(HasCallStack, MonadCatch m) =>
(SomeException -> m a) -> m a -> m a
Exception.handleAny (Result SomeException a -> IO (Result SomeException a)
forall a. a -> IO 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 :: forall e a. (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.
(HasCallStack, 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) => Text -> Stack.SrcLoc
getFrame :: HasCallStack => Text -> SrcLoc
getFrame Text
testName =
  case 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 of
    Just (String
_, SrcLoc
srcLoc) ->
      SrcLoc
srcLoc
    Maybe (String, SrcLoc)
Nothing ->
      ( Text
"Oops! We can't find the source location for this test: "
          Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
testName
          Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"\n"
          Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"This indicates a bug in our Test module in nri-prelude.\n"
      )
        Text -> (Text -> Failure) -> Failure
forall a b. a -> (a -> b) -> b
|> Text -> Failure
TestRunnerMessedUp
        Failure -> (Failure -> SrcLoc) -> SrcLoc
forall a b. a -> (a -> b) -> b
|> Failure -> SrcLoc
forall e a. (HasCallStack, Exception e) => e -> a
Exception.impureThrow

groupBy :: (Ord key) => (a -> key) -> [a] -> Dict.Dict key [a]
groupBy :: forall key a. Ord key => (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

-- Assertion constructors
-- All exposed assertion functions should call these functions internally and
-- never each other, to ensure a single unnested 'expectation' entry from
-- appearing in log-explorer traces.

pass :: (Stack.HasCallStack) => Text -> a -> Expectation' a
pass :: forall a. HasCallStack => 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
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 :: forall a. HasCallStack => Text -> Text -> Expectation' a
failAssertion Text
name Text
err =
  Text -> SrcLoc -> Failure
FailedAssertion Text
err ((HasCallStack => Text -> SrcLoc) -> Text -> SrcLoc
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> SrcLoc
Text -> SrcLoc
getFrame Text
name)
    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
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 :: forall a. HasCallStack => 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
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