module Test.Hspec.Discover (
Spec
, hspec
, hspecWithFormatter
, postProcessSpec
, describe
, module Prelude
) where
import Control.Applicative
import Data.Maybe
import Data.List
import Data.Traversable hiding (mapM)
import Control.Monad.Trans.State
import Test.Hspec
import Test.Hspec.Core.Type
import Test.Hspec.Runner
import Test.Hspec.Runner.Tree
import Test.Hspec.Formatters
import Test.Hspec.Util
hspecWithFormatter :: IsFormatter a => a -> Spec -> IO ()
hspecWithFormatter formatter spec = do
f <- toFormatter formatter
hspecWith defaultConfig {configFormatter = Just f} spec
postProcessSpec :: FilePath -> Spec -> Spec
postProcessSpec = locationHeuristicFromFile
locationHeuristicFromFile :: FilePath -> Spec -> Spec
locationHeuristicFromFile file spec = do
mInput <- either (const Nothing) Just <$> (runIO . safeTry . readFile) file
let lookupLoc = maybe (\_ _ _ -> Nothing) (lookupLocation file) mInput
runIO (toTree spec) >>= fromTree . addLoctions lookupLoc
addLoctions :: (Int -> Int -> String -> Maybe Location) -> [Tree Item] -> [Tree Item]
addLoctions lookupLoc = map (fmap f) . enumerate
where
f :: ((Int, Int), Item) -> Item
f ((n, total), item) = item {itemLocation = itemLocation item <|> lookupLoc n total (itemRequirement item)}
type EnumerateM = State [(String, Int)]
enumerate :: [Tree Item] -> [Tree ((Int, Int), Item)]
enumerate tree = (mapM (traverse addPosition) tree >>= mapM (traverse addTotal)) `evalState` []
where
addPosition :: Item -> EnumerateM (Int, Item)
addPosition item = (,) <$> getOccurrence (itemRequirement item) <*> pure item
addTotal :: (Int, Item) -> EnumerateM ((Int, Int), Item)
addTotal (n, item) = do
total <- getTotal (itemRequirement item)
return ((n, total), item)
getTotal :: String -> EnumerateM Int
getTotal requirement = do
gets $ fromMaybe err . lookup requirement
where
err = error ("Test.Hspec.Discover.getTotal: No entry for requirement " ++ show requirement ++ "!")
getOccurrence :: String -> EnumerateM Int
getOccurrence requirement = do
xs <- get
let n = maybe 1 succ (lookup requirement xs)
put ((requirement, n) : filter ((/= requirement) . fst) xs)
return n
lookupLocation :: FilePath -> String -> Int -> Int -> String -> Maybe Location
lookupLocation file input n total requirement = loc
where
loc :: Maybe Location
loc = Location file <$> line <*> pure 0 <*> pure BestEffort
line :: Maybe Int
line = case occurrences of
xs | length xs == total -> Just (xs !! pred n)
_ -> Nothing
occurrences :: [Int]
occurrences = map fst (filter p inputLines)
where
p :: (Int, String) -> Bool
p = isInfixOf (show requirement) . snd
inputLines :: [(Int, String)]
inputLines = zip [1..] (lines input)