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 :: (TracingSpan -> IO ()) -> SuiteResult -> IO () report TracingSpan -> IO () writeSpan SuiteResult results = do String 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 :: [TracingSpan] testSpans = SuiteResult -> [TracingSpan] spans SuiteResult results let maybeFrame :: Maybe (Text, SrcLoc) 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 :: TracingSpan rootSpan = TracingSpan :: Text -> MonotonicTime -> MonotonicTime -> Maybe (Text, SrcLoc) -> Maybe SomeTracingSpanDetails -> Maybe Text -> Succeeded -> Int -> [TracingSpan] -> TracingSpan 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, allocated :: Int Platform.allocated = Int 0, children :: [TracingSpan] Platform.children = [TracingSpan] testSpans } TracingSpan -> IO () writeSpan TracingSpan 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 (TracingSpan, Failure)] 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 (TracingSpan, Failure) -> ([Text], TracingSpan)) -> [SingleTest (TracingSpan, Failure)] -> [([Text], TracingSpan)] forall a b. (a -> b) -> List a -> List b List.map (((TracingSpan, Failure) -> TracingSpan) -> ([Text], (TracingSpan, Failure)) -> ([Text], TracingSpan) forall b y a. (b -> y) -> (a, b) -> (a, y) Tuple.mapSecond (TracingSpan, Failure) -> TracingSpan forall a b. (a, b) -> a Tuple.first (([Text], (TracingSpan, Failure)) -> ([Text], TracingSpan)) -> (SingleTest (TracingSpan, Failure) -> ([Text], (TracingSpan, Failure))) -> SingleTest (TracingSpan, Failure) -> ([Text], TracingSpan) forall b c a. (b -> c) -> (a -> b) -> a -> c << SingleTest (TracingSpan, Failure) -> ([Text], (TracingSpan, Failure)) forall body. SingleTest body -> ([Text], body) bodyAndDescribes) [SingleTest (TracingSpan, Failure)] failed SuiteResult Internal.NoTestsInSuite -> [] where bodyAndDescribes :: Internal.SingleTest body -> ([Text], body) bodyAndDescribes :: 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) 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 -> [ TracingSpan :: Text -> MonotonicTime -> MonotonicTime -> Maybe (Text, SrcLoc) -> Maybe SomeTracingSpanDetails -> Maybe Text -> Succeeded -> Int -> [TracingSpan] -> TracingSpan 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'), 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 :: (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