module Test.Reporter.Logfile
  ( report,
  )
where

import qualified Data.Text
import qualified Dict
import qualified GHC.Stack as Stack
import qualified List
import qualified Maybe
import NriPrelude
import qualified Platform.Internal as Platform
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath
import qualified Test.Internal as Internal
import qualified Tuple
import qualified Prelude

report ::
  (Stack.HasCallStack) =>
  (Platform.TracingSpan -> Prelude.IO ()) ->
  Internal.SuiteResult ->
  Prelude.IO ()
report :: HasCallStack => (TracingSpan -> IO ()) -> SuiteResult -> IO ()
report TracingSpan -> IO ()
writeSpan SuiteResult
results = do
  projectDir <- (String -> String) -> IO String -> IO String
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map String -> String
FilePath.takeBaseName IO String
Directory.getCurrentDirectory
  let testSpans = SuiteResult -> [TracingSpan]
spans SuiteResult
results
  let maybeFrame =
        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 (Text, SrcLoc))
-> Maybe (Text, SrcLoc)
forall a b. a -> (a -> b) -> b
|> ((String, SrcLoc) -> (Text, SrcLoc))
-> Maybe (String, SrcLoc) -> Maybe (Text, SrcLoc)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map ((String -> Text) -> (String, SrcLoc) -> (Text, SrcLoc)
forall a x b. (a -> x) -> (a, b) -> (x, b)
Tuple.mapFirst String -> Text
Data.Text.pack)
  let rootSpan =
        Platform.TracingSpan
          { name :: Text
Platform.name = Text
"test run",
            started :: MonotonicTime
Platform.started =
              List MonotonicTime -> Maybe MonotonicTime
forall a. Ord a => List a -> Maybe a
List.minimum ((TracingSpan -> MonotonicTime)
-> [TracingSpan] -> List MonotonicTime
forall a b. (a -> b) -> List a -> List b
List.map TracingSpan -> MonotonicTime
Platform.started [TracingSpan]
testSpans)
                Maybe MonotonicTime
-> (Maybe MonotonicTime -> MonotonicTime) -> MonotonicTime
forall a b. a -> (a -> b) -> b
|> MonotonicTime -> Maybe MonotonicTime -> MonotonicTime
forall a. a -> Maybe a -> a
Maybe.withDefault (Word64 -> MonotonicTime
Platform.MonotonicTime Word64
0),
            finished :: MonotonicTime
Platform.finished =
              List MonotonicTime -> Maybe MonotonicTime
forall a. Ord a => List a -> Maybe a
List.maximum ((TracingSpan -> MonotonicTime)
-> [TracingSpan] -> List MonotonicTime
forall a b. (a -> b) -> List a -> List b
List.map TracingSpan -> MonotonicTime
Platform.finished [TracingSpan]
testSpans)
                Maybe MonotonicTime
-> (Maybe MonotonicTime -> MonotonicTime) -> MonotonicTime
forall a b. a -> (a -> b) -> b
|> MonotonicTime -> Maybe MonotonicTime -> MonotonicTime
forall a. a -> Maybe a -> a
Maybe.withDefault (Word64 -> MonotonicTime
Platform.MonotonicTime Word64
0),
            frame :: Maybe (Text, SrcLoc)
Platform.frame = Maybe (Text, SrcLoc)
maybeFrame,
            details :: Maybe SomeTracingSpanDetails
Platform.details = Maybe SomeTracingSpanDetails
forall a. Maybe a
Nothing,
            summary :: Maybe Text
Platform.summary = Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
Data.Text.pack String
projectDir),
            succeeded :: Succeeded
Platform.succeeded = case SuiteResult
results of
              Internal.AllPassed [SingleTest TracingSpan]
_ -> Succeeded
Platform.Succeeded
              SuiteResult
_ -> Succeeded
Platform.Failed,
            containsFailures :: Bool
Platform.containsFailures = case SuiteResult
results of
              Internal.AllPassed [SingleTest TracingSpan]
_ -> Bool
False
              SuiteResult
_ -> Bool
True,
            allocated :: Int
Platform.allocated = Int
0,
            children :: [TracingSpan]
Platform.children = [TracingSpan]
testSpans
          }
  writeSpan rootSpan

spans :: Internal.SuiteResult -> [Platform.TracingSpan]
spans :: SuiteResult -> [TracingSpan]
spans SuiteResult
results =
  SuiteResult -> [([Text], TracingSpan)]
spansAndNamespaces SuiteResult
results
    [([Text], TracingSpan)]
-> ([([Text], TracingSpan)] -> [TracingSpan]) -> [TracingSpan]
forall a b. a -> (a -> b) -> b
|> [([Text], TracingSpan)] -> [TracingSpan]
groupIntoNamespaces

spansAndNamespaces :: Internal.SuiteResult -> [([Text], Platform.TracingSpan)]
spansAndNamespaces :: SuiteResult -> [([Text], TracingSpan)]
spansAndNamespaces SuiteResult
results =
  case SuiteResult
results of
    Internal.AllPassed [SingleTest TracingSpan]
tests -> (SingleTest TracingSpan -> ([Text], TracingSpan))
-> [SingleTest TracingSpan] -> [([Text], TracingSpan)]
forall a b. (a -> b) -> List a -> List b
List.map SingleTest TracingSpan -> ([Text], TracingSpan)
forall body. SingleTest body -> ([Text], body)
bodyAndDescribes [SingleTest TracingSpan]
tests
    Internal.OnlysPassed [SingleTest TracingSpan]
tests [SingleTest NotRan]
_ -> (SingleTest TracingSpan -> ([Text], TracingSpan))
-> [SingleTest TracingSpan] -> [([Text], TracingSpan)]
forall a b. (a -> b) -> List a -> List b
List.map SingleTest TracingSpan -> ([Text], TracingSpan)
forall body. SingleTest body -> ([Text], body)
bodyAndDescribes [SingleTest TracingSpan]
tests
    Internal.PassedWithSkipped [SingleTest TracingSpan]
tests [SingleTest NotRan]
_ -> (SingleTest TracingSpan -> ([Text], TracingSpan))
-> [SingleTest TracingSpan] -> [([Text], TracingSpan)]
forall a b. (a -> b) -> List a -> List b
List.map SingleTest TracingSpan -> ([Text], TracingSpan)
forall body. SingleTest body -> ([Text], body)
bodyAndDescribes [SingleTest TracingSpan]
tests
    Internal.TestsFailed [SingleTest TracingSpan]
passed [SingleTest NotRan]
_ [SingleTest FailedSpan]
failed ->
      (SingleTest TracingSpan -> ([Text], TracingSpan))
-> [SingleTest TracingSpan] -> [([Text], TracingSpan)]
forall a b. (a -> b) -> List a -> List b
List.map SingleTest TracingSpan -> ([Text], TracingSpan)
forall body. SingleTest body -> ([Text], body)
bodyAndDescribes [SingleTest TracingSpan]
passed
        [([Text], TracingSpan)]
-> [([Text], TracingSpan)] -> [([Text], TracingSpan)]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ (SingleTest FailedSpan -> ([Text], TracingSpan))
-> [SingleTest FailedSpan] -> [([Text], TracingSpan)]
forall a b. (a -> b) -> List a -> List b
List.map (SingleTest FailedSpan -> ([Text], FailedSpan)
forall body. SingleTest body -> ([Text], body)
bodyAndDescribes (SingleTest FailedSpan -> ([Text], FailedSpan))
-> (([Text], FailedSpan) -> ([Text], TracingSpan))
-> SingleTest FailedSpan
-> ([Text], TracingSpan)
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> ([Text], FailedSpan) -> ([Text], TracingSpan)
failedSpan) [SingleTest FailedSpan]
failed
    SuiteResult
Internal.NoTestsInSuite -> []
  where
    bodyAndDescribes :: Internal.SingleTest body -> ([Text], body)
    bodyAndDescribes :: forall body. SingleTest body -> ([Text], body)
bodyAndDescribes SingleTest body
test = (SingleTest body -> [Text]
forall a. SingleTest a -> [Text]
Internal.describes SingleTest body
test, SingleTest body -> body
forall a. SingleTest a -> a
Internal.body SingleTest body
test)
    failedSpan :: ([Text], Internal.FailedSpan) -> ([Text], Platform.TracingSpan)
    failedSpan :: ([Text], FailedSpan) -> ([Text], TracingSpan)
failedSpan ([Text]
text, (Internal.FailedSpan TracingSpan
span Failure
_)) = ([Text]
text, TracingSpan
span)

groupIntoNamespaces :: [([Text], Platform.TracingSpan)] -> [Platform.TracingSpan]
groupIntoNamespaces :: [([Text], TracingSpan)] -> [TracingSpan]
groupIntoNamespaces [([Text], TracingSpan)]
namespacedSpans =
  [([Text], TracingSpan)]
namespacedSpans
    [([Text], TracingSpan)]
-> ([([Text], TracingSpan)]
    -> Dict (Maybe Text) [([Text], TracingSpan)])
-> Dict (Maybe Text) [([Text], TracingSpan)]
forall a b. a -> (a -> b) -> b
|> (([Text], TracingSpan) -> Maybe Text)
-> [([Text], TracingSpan)]
-> Dict (Maybe Text) [([Text], TracingSpan)]
forall b a. Ord b => (a -> b) -> List a -> Dict b (List a)
groupBy ([Text] -> Maybe Text
forall a. List a -> Maybe a
List.head ([Text] -> Maybe Text)
-> (([Text], TracingSpan) -> [Text])
-> ([Text], TracingSpan)
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< ([Text], TracingSpan) -> [Text]
forall a b. (a, b) -> a
Tuple.first)
    Dict (Maybe Text) [([Text], TracingSpan)]
-> (Dict (Maybe Text) [([Text], TracingSpan)]
    -> List (Maybe Text, [([Text], TracingSpan)]))
-> List (Maybe Text, [([Text], TracingSpan)])
forall a b. a -> (a -> b) -> b
|> Dict (Maybe Text) [([Text], TracingSpan)]
-> List (Maybe Text, [([Text], TracingSpan)])
forall k v. Dict k v -> List (k, v)
Dict.toList
    List (Maybe Text, [([Text], TracingSpan)])
-> (List (Maybe Text, [([Text], TracingSpan)]) -> [TracingSpan])
-> [TracingSpan]
forall a b. a -> (a -> b) -> b
|> ((Maybe Text, [([Text], TracingSpan)]) -> [TracingSpan])
-> List (Maybe Text, [([Text], TracingSpan)]) -> [TracingSpan]
forall a b. (a -> List b) -> List a -> List b
List.concatMap
      ( \(Maybe Text
headNamespace, [([Text], TracingSpan)]
namespacedSpanGroup) ->
          let spans' :: [TracingSpan]
spans' = (([Text], TracingSpan) -> TracingSpan)
-> [([Text], TracingSpan)] -> [TracingSpan]
forall a b. (a -> b) -> List a -> List b
List.map ([Text], TracingSpan) -> TracingSpan
forall a b. (a, b) -> b
Tuple.second [([Text], TracingSpan)]
namespacedSpanGroup
           in case Maybe Text
headNamespace of
                Maybe Text
Nothing -> [TracingSpan]
spans'
                Just Text
namespace ->
                  [ Platform.TracingSpan
                      { name :: Text
Platform.name = Text
"describe",
                        started :: MonotonicTime
Platform.started =
                          List MonotonicTime -> Maybe MonotonicTime
forall a. Ord a => List a -> Maybe a
List.minimum ((TracingSpan -> MonotonicTime)
-> [TracingSpan] -> List MonotonicTime
forall a b. (a -> b) -> List a -> List b
List.map TracingSpan -> MonotonicTime
Platform.started [TracingSpan]
spans')
                            Maybe MonotonicTime
-> (Maybe MonotonicTime -> MonotonicTime) -> MonotonicTime
forall a b. a -> (a -> b) -> b
|> MonotonicTime -> Maybe MonotonicTime -> MonotonicTime
forall a. a -> Maybe a -> a
Maybe.withDefault (Word64 -> MonotonicTime
Platform.MonotonicTime Word64
0),
                        finished :: MonotonicTime
Platform.finished =
                          List MonotonicTime -> Maybe MonotonicTime
forall a. Ord a => List a -> Maybe a
List.maximum ((TracingSpan -> MonotonicTime)
-> [TracingSpan] -> List MonotonicTime
forall a b. (a -> b) -> List a -> List b
List.map TracingSpan -> MonotonicTime
Platform.finished [TracingSpan]
spans')
                            Maybe MonotonicTime
-> (Maybe MonotonicTime -> MonotonicTime) -> MonotonicTime
forall a b. a -> (a -> b) -> b
|> MonotonicTime -> Maybe MonotonicTime -> MonotonicTime
forall a. a -> Maybe a -> a
Maybe.withDefault (Word64 -> MonotonicTime
Platform.MonotonicTime Word64
0),
                        frame :: Maybe (Text, SrcLoc)
Platform.frame = Maybe (Text, SrcLoc)
forall a. Maybe a
Nothing,
                        details :: Maybe SomeTracingSpanDetails
Platform.details = Maybe SomeTracingSpanDetails
forall a. Maybe a
Nothing,
                        summary :: Maybe Text
Platform.summary = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
namespace,
                        succeeded :: Succeeded
Platform.succeeded =
                          [Succeeded] -> Succeeded
forall a. Monoid a => [a] -> a
Prelude.mconcat ((TracingSpan -> Succeeded) -> [TracingSpan] -> [Succeeded]
forall a b. (a -> b) -> List a -> List b
List.map TracingSpan -> Succeeded
Platform.succeeded [TracingSpan]
spans'),
                        containsFailures :: Bool
Platform.containsFailures =
                          (TracingSpan -> Bool) -> [TracingSpan] -> Bool
forall a. (a -> Bool) -> List a -> Bool
List.any TracingSpan -> Bool
Platform.containsFailures [TracingSpan]
spans',
                        allocated :: Int
Platform.allocated = Int
0,
                        children :: [TracingSpan]
Platform.children =
                          [([Text], TracingSpan)]
namespacedSpanGroup
                            [([Text], TracingSpan)]
-> ([([Text], TracingSpan)] -> [([Text], TracingSpan)])
-> [([Text], TracingSpan)]
forall a b. a -> (a -> b) -> b
|> (([Text], TracingSpan) -> Maybe ([Text], TracingSpan))
-> [([Text], TracingSpan)] -> [([Text], TracingSpan)]
forall a b. (a -> Maybe b) -> List a -> List b
List.filterMap
                              ( \([Text]
namespaces, TracingSpan
span) ->
                                  case [Text]
namespaces of
                                    [] -> Maybe ([Text], TracingSpan)
forall a. Maybe a
Nothing
                                    Text
_ : [Text]
rest -> ([Text], TracingSpan) -> Maybe ([Text], TracingSpan)
forall a. a -> Maybe a
Just ([Text]
rest, TracingSpan
span)
                              )
                            [([Text], TracingSpan)]
-> ([([Text], TracingSpan)] -> [TracingSpan]) -> [TracingSpan]
forall a b. a -> (a -> b) -> b
|> [([Text], TracingSpan)] -> [TracingSpan]
groupIntoNamespaces
                      }
                  ]
      )

groupBy :: (Ord b) => (a -> b) -> List a -> Dict.Dict b (List a)
groupBy :: forall b a. Ord b => (a -> b) -> List a -> Dict b (List a)
groupBy a -> b
f List a
list =
  (a -> Dict b (List a) -> Dict b (List a))
-> Dict b (List a) -> List a -> Dict b (List a)
forall a b. (a -> b -> b) -> b -> List a -> b
List.foldr
    ( \a
x ->
        b
-> (Maybe (List a) -> Maybe (List a))
-> Dict b (List a)
-> Dict b (List a)
forall comparable v.
Ord comparable =>
comparable
-> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v
Dict.update (a -> b
f a
x) ((Maybe (List a) -> Maybe (List a))
 -> Dict b (List a) -> Dict b (List a))
-> (Maybe (List a) -> Maybe (List a))
-> Dict b (List a)
-> Dict b (List a)
forall a b. (a -> b) -> a -> b
<| \Maybe (List a)
val ->
          case Maybe (List a)
val of
            Maybe (List a)
Nothing -> List a -> Maybe (List a)
forall a. a -> Maybe a
Just [a
x]
            Just List a
xs -> List a -> Maybe (List a)
forall a. a -> Maybe a
Just (a
x a -> List a -> List a
forall a. a -> [a] -> [a]
: List a
xs)
    )
    Dict b (List a)
forall k v. Dict k v
Dict.empty
    List a
list