Fix tests

This commit is contained in:
Daniel Gröber 2015-09-14 10:11:33 +02:00
parent 5b02cc1bb0
commit 0aa3655e08
3 changed files with 20 additions and 13 deletions

View File

@ -28,7 +28,7 @@ spec = do
describe "`browse' in a project directory" $ do
it "can list symbols defined in a a local module" $ do
withDirectory_ "test/data/ghc-mod-check/lib" $ do
withDirectory_ "test/data/ghc-mod-check/" $ do
syms <- runD $ lines <$> browse "Data.Foo"
syms `shouldContain` ["foo"]
syms `shouldContain` ["fibonacci"]

View File

@ -9,7 +9,7 @@ spec = do
describe "When using GhcModT in a do block" $
it "a pattern match failure causes a call to `fail` on ErrorT in the monad stack" $ do
(a, _h)
<- runGhcModT defaultOptions $
<- runGmOutDef $ runGhcModT defaultOptions $
do
Just _ <- return Nothing
return "hello"

View File

@ -20,7 +20,6 @@ import Language.Haskell.GhcMod.Types
import Control.Arrow
import Control.Category
import Control.Concurrent
import Control.Applicative
import Control.Monad.Error (ErrorT, runErrorT)
import Control.Monad.Trans.Journal
@ -45,11 +44,21 @@ extract action = do
Left e -> error $ show e
withSpecCradle :: (IOish m, GmOut m) => FilePath -> (Cradle -> m a) -> m a
withSpecCradle cradledir f =
gbracket (findSpecCradle cradledir) (liftIO . cleanupCradle) f
withSpecCradle cradledir f = do
gbracket (findSpecCradle cradledir) (liftIO . cleanupCradle) $ \crdl ->
bracketWorkingDirectory (cradleRootDir crdl) $
f crdl
withGhcModEnvSpec :: (IOish m, GmOut m) => FilePath -> Options -> (GhcModEnv -> m a) -> m a
withGhcModEnvSpec = withGhcModEnv' withSpecCradle
bracketWorkingDirectory ::
(ExceptionMonad m, MonadIO m) => FilePath -> m c -> m c
bracketWorkingDirectory dir a =
gbracket (swapWorkingDirectory dir) (liftIO . setCurrentDirectory) (const a)
swapWorkingDirectory :: MonadIO m => FilePath -> m FilePath
swapWorkingDirectory ndir = liftIO $ do
odir <- getCurrentDirectory >>= canonicalizePath
setCurrentDirectory $ ndir
return odir
runGhcModTSpec :: Options -> GhcModT IO a -> IO (Either GhcModError a, GhcModLog)
runGhcModTSpec opt action = do
@ -59,10 +68,9 @@ runGhcModTSpec opt action = do
runGhcModTSpec' :: IOish m
=> FilePath -> Options -> GhcModT m b -> m (Either GhcModError b, GhcModLog)
runGhcModTSpec' dir opt action = liftIO (canonicalizePath dir) >>= \dir' -> do
gmo <- GhcModOut (optOutput opt) <$> liftIO newChan
runGmOutT gmo $
withGhcModEnvSpec dir' opt $ \env -> do
first (fst <$>) <$> runGhcModT'' env defaultGhcModState
runGmOutT opt $
withGhcModEnv' withSpecCradle dir' opt $ \env -> do
first (fst <$>) <$> runGhcModT' env defaultGhcModState
(gmSetLogLevel (ooptLogLevel $ optOutput opt) >> action)
-- | Run GhcMod
@ -91,8 +99,7 @@ runNullLog action = do
return a
runGmOutDef :: IOish m => GmOutT m a -> m a
runGmOutDef =
runGmOutT (GhcModOut (optOutput defaultOptions) (error "no chan"))
runGmOutDef = runGmOutT defaultOptions
shouldReturnError :: Show a
=> IO (Either GhcModError a, GhcModLog)