58 lines
1.5 KiB
Haskell
58 lines
1.5 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
module GhcMod.Exe.Test where
|
|
|
|
import Control.Applicative
|
|
import Data.List
|
|
import System.FilePath
|
|
import System.Directory
|
|
import Prelude
|
|
|
|
import GhcMod.Types
|
|
import GhcMod.Monad
|
|
import GhcMod.DynFlags
|
|
|
|
import GHC
|
|
import GHC.Exception
|
|
import OccName
|
|
|
|
test :: IOish m
|
|
=> FilePath -> GhcModT m String
|
|
test f = runGmlT' [Left f] (fmap setHscInterpreted . deferErrors) $ do
|
|
mg <- getModuleGraph
|
|
root <- cradleRootDir <$> cradle
|
|
f' <- makeRelative root <$> liftIO (canonicalizePath f)
|
|
let Just ms = find ((==Just f') . ml_hs_file . ms_location) mg
|
|
mdl = ms_mod ms
|
|
mn = moduleName mdl
|
|
|
|
Just mi <- getModuleInfo mdl
|
|
let exs = map (occNameString . getOccName) $ modInfoExports mi
|
|
cqs = filter ("prop_" `isPrefixOf`) exs
|
|
|
|
setContext [ IIDecl $ simpleImportDecl mn
|
|
, IIDecl $ simpleImportDecl $ mkModuleName "Test.QuickCheck"
|
|
]
|
|
|
|
_res <- mapM runTest cqs
|
|
|
|
return ""
|
|
|
|
#if __GLASGOW_HASKELL__ >= 802
|
|
runTest :: GhcMonad m => String -> m (Maybe SomeException)
|
|
runTest fn = do
|
|
res <- execStmt ("quickCheck " ++ fn) execOptions
|
|
return $ case res of
|
|
ExecComplete (Right _) _ -> Nothing
|
|
ExecComplete (Left se) _ -> Just se
|
|
_ -> error "runTest"
|
|
#else
|
|
runTest :: GhcMonad m => String -> m (Maybe SomeException)
|
|
runTest fn = do
|
|
res <- runStmt ("quickCheck " ++ fn) RunToCompletion
|
|
return $ case res of
|
|
RunOk [] -> Nothing
|
|
RunException se -> Just se
|
|
_ -> error "runTest"
|
|
#endif
|