module Test.Hspec.Discover (Spec, hspec, hspecWithFormatter, postProcessSpec, describe) 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 hiding (describe)
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)