Add 'test' command for running QuickCheck props

Language/Haskell/GhcMod.hs

@@ -44,6 +44,7 @@ module Language.Haskell.GhcMod (
   , pkgDoc
   , rootInfo
   , types
+  , test
   , splits
   , sig
   , refine
@@ -88,3 +89,4 @@ import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Target
 import Language.Haskell.GhcMod.Output
 import Language.Haskell.GhcMod.FileMapping
+import Language.Haskell.GhcMod.Test

Language/Haskell/GhcMod/Test.hs

@@ -0,0 +1,43 @@
+module Language.Haskell.GhcMod.Test where
+
+import Data.List
+import System.FilePath
+import System.Directory
+
+import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.DynFlags
+
+import GHC  --(ModSummary(..), ModLocation(..), moduleName, findModule)
+import GHC.Exception
+import OccName
+
+test :: IOish m
+      => FilePath -> GhcModT m String
+test f = runGmlT' [Left f] (return . setHscInterpreted) $ 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 ""
+
+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"

ghc-mod.cabal

@@ -140,6 +140,7 @@ Library
                         Language.Haskell.GhcMod.SrcUtils
                         Language.Haskell.GhcMod.Stack
                         Language.Haskell.GhcMod.Target
+                        Language.Haskell.GhcMod.Test
                         Language.Haskell.GhcMod.Types
                         Language.Haskell.GhcMod.Utils
                         Language.Haskell.GhcMod.World

src/GHCMod.hs

@@ -161,6 +161,7 @@ ghcCommands (CmdMapFile f) =
   >>  return ""
 ghcCommands (CmdUnmapFile f) = unloadMappedFile f >> return ""
 ghcCommands (CmdQuit) = liftIO exitSuccess
+ghcCommands (CmdTest file) = test file
 ghcCommands cmd = throw $ InvalidCommandLine $ Left $ show cmd
 
 newtype InvalidCommandLine = InvalidCommandLine (Either String String)

src/GHCMod/Options/Commands.hs

@@ -60,6 +60,7 @@ data GhcModCommands =
   | CmdMapFile FilePath
   | CmdUnmapFile FilePath
   | CmdQuit
+  | CmdTest FilePath
   deriving (Show)
 
 commandsSpec :: Parser GhcModCommands
@@ -182,6 +183,10 @@ commands =
                 \\ " `[a]', which results in:"
               code "filterNothing xs = filter _body_1 _body_2"
               "(See also: https://github.com/kazu-yamamoto/ghc-mod/issues/311)"
+    <> command "test"
+          $$  info (CmdTest <$> strArg "FILE")
+          $$  progDesc ""
+
 
 interactiveCommandsSpec :: Parser GhcModCommands
 interactiveCommandsSpec =