{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Test.Hspec.Core.Runner.PrintSlowSpecItems (
  printSlowSpecItems
) where

import           Prelude ()
import           Test.Hspec.Core.Compat

import           System.IO (stderr, hPutStrLn)

import           Test.Hspec.Core.Util
import           Test.Hspec.Core.Format

import           Test.Hspec.Core.Clock
import           Test.Hspec.Core.Formatters.V2 (formatLocation)

data SlowItem = SlowItem {
  SlowItem -> Maybe Location
location :: Maybe Location
, SlowItem -> Path
path :: Path
, SlowItem -> Int
duration :: Int
}

printSlowSpecItems :: Int -> Format -> Format
printSlowSpecItems :: Int -> Format -> Format
printSlowSpecItems Int
n Format
format Event
event = do
  Format
format Event
event
  case Event
event of
    Done [(Path, Item)]
items -> do
      let xs :: [SlowItem]
xs = Int -> [SlowItem] -> [SlowItem]
slowItems Int
n forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Path, Item) -> SlowItem
toSlowItem [(Path, Item)]
items
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SlowItem]
xs) forall a b. (a -> b) -> a -> b
$ do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"\nSlow spec items:"
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SlowItem -> IO ()
printSlowSpecItem [SlowItem]
xs
    Event
_ -> forall (m :: * -> *). Applicative m => m ()
pass

toSlowItem :: (Path, Item) -> SlowItem
toSlowItem :: (Path, Item) -> SlowItem
toSlowItem (Path
path, Item
item) = Maybe Location -> Path -> Int -> SlowItem
SlowItem (Item -> Maybe Location
itemLocation Item
item)  Path
path (Seconds -> Int
toMilliseconds forall a b. (a -> b) -> a -> b
$ Item -> Seconds
itemDuration Item
item)

slowItems :: Int -> [SlowItem] -> [SlowItem]
slowItems :: Int -> [SlowItem] -> [SlowItem]
slowItems Int
n = forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn SlowItem -> Int
duration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlowItem -> Int
duration)

printSlowSpecItem :: SlowItem -> IO ()
printSlowSpecItem :: SlowItem -> IO ()
printSlowSpecItem SlowItem{Int
Maybe Location
Path
duration :: Int
path :: Path
location :: Maybe Location
duration :: SlowItem -> Int
path :: SlowItem -> Path
location :: SlowItem -> Maybe Location
..} = do
  Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"  " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Location -> String
formatLocation Maybe Location
location forall a. [a] -> [a] -> [a]
++ Path -> String
joinPath Path
path forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
duration forall a. [a] -> [a] -> [a]
++ String
"ms)"