module CmdLine.Test(testFile) where
import Hoogle.All
import Hoogle.Item.All
import General.Code
import Data.Binary.Defer.Index
testFile :: FilePath -> FilePath -> IO ()
testFile srcfile dbfile = do
putStrLn $ "Testing " ++ srcfile
db <- loadDataBase dbfile
src <- readFile srcfile
let bad = filter (not . runTest db) $ catMaybes $ zipWith parseTest [1..] $ lines src
if null bad then
putStrLn "All tests passed"
else do
putStr $ unlines $ map failedTest bad
putStrLn $ show (length bad) ++ " tests failed"
data Test = Test Int String Query [String] [[String]]
deriving Show
parseTest :: Int -> String -> Maybe Test
parseTest line str | "@test " `isPrefixOf` str =
case reads $ drop 5 str of
[(x,rest)] -> case parseQuery x of
Right q -> let (no,yes) = partition ("!" `isPrefixOf`) $ words rest
in Just $ Test line x q (map tail no) (map (split ',') yes)
_ -> err
_ -> err
where err = error $ "Couldn't parse @test on line " ++ show line
parseTest line str = Nothing
runTest :: DataBase -> Test -> Bool
runTest db (Test _ _ q bad ans) =
ordered (group $ map resultScore res) &&
all (`elem` map fst items) (concat ans) &&
ordered (map (map (`lookupJust` items)) ans) &&
all (`notElem` map fst items) bad
where
res = searchAll [db] q
items = map (entryName . fromLink . resultEntry &&& resultScore) res
ordered ((x:xs):(y:ys):zs) = x < y && all (== x) xs && ordered ((y:ys):zs)
ordered [x:xs] = all (== x) xs
ordered [] = True
failedTest :: Test -> String
failedTest (Test line str _ _ _) = "Line " ++ show line ++ ", " ++ str