Fix tests more
This commit is contained in:
parent
ba14e1790c
commit
55f278853a
@ -43,7 +43,7 @@ findCradle' dir = run $
|
|||||||
|
|
||||||
findSpecCradle :: (IOish m, GmOut m) => FilePath -> m Cradle
|
findSpecCradle :: (IOish m, GmOut m) => FilePath -> m Cradle
|
||||||
findSpecCradle dir = do
|
findSpecCradle dir = do
|
||||||
let cfs = [stackCradle, cabalCradle, sandboxCradle]
|
let cfs = [stackCradleSpec, cabalCradle, sandboxCradle]
|
||||||
cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs
|
cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs
|
||||||
gcs <- filterM isNotGmCradle cs
|
gcs <- filterM isNotGmCradle cs
|
||||||
fillTempDir =<< case gcs of
|
fillTempDir =<< case gcs of
|
||||||
@ -99,6 +99,19 @@ stackCradle wdir = do
|
|||||||
, cradleDistDir = seDistDir senv
|
, cradleDistDir = seDistDir senv
|
||||||
}
|
}
|
||||||
|
|
||||||
|
stackCradleSpec :: (IOish m, GmOut m) => FilePath -> MaybeT m Cradle
|
||||||
|
stackCradleSpec wdir = do
|
||||||
|
crdl <- stackCradle wdir
|
||||||
|
case crdl of
|
||||||
|
Cradle { cradleProject = StackProject StackEnv { seDistDir } } -> do
|
||||||
|
b <- isGmDistDir seDistDir
|
||||||
|
when b mzero
|
||||||
|
return crdl
|
||||||
|
_ -> error "stackCradleSpec"
|
||||||
|
where
|
||||||
|
isGmDistDir dir =
|
||||||
|
liftIO $ not <$> doesFileExist (dir </> ".." </> "ghc-mod.cabal")
|
||||||
|
|
||||||
sandboxCradle :: IOish m => FilePath -> MaybeT m Cradle
|
sandboxCradle :: IOish m => FilePath -> MaybeT m Cradle
|
||||||
sandboxCradle wdir = do
|
sandboxCradle wdir = do
|
||||||
sbDir <- MaybeT $ liftIO $ findCabalSandboxDir wdir
|
sbDir <- MaybeT $ liftIO $ findCabalSandboxDir wdir
|
||||||
|
@ -69,9 +69,14 @@ withGhcModEnv' withCradle dir opts f =
|
|||||||
c <- gmoChan <$> gmoAsk
|
c <- gmoChan <$> gmoAsk
|
||||||
gbracket_ (liftIO $ forkIO $ stdoutGateway c) (liftIO . killThread) a
|
gbracket_ (liftIO $ forkIO $ stdoutGateway c) (liftIO . killThread) a
|
||||||
|
|
||||||
withCradleRootDir (cradleRootDir -> projdir) =
|
withCradleRootDir (cradleRootDir -> projdir) a =
|
||||||
gbracket_ (liftIO $ setCurrentDirectory projdir >> getCurrentDirectory)
|
gbracket_ (liftIO $ swapCurrentDirectory projdir)
|
||||||
(liftIO . setCurrentDirectory)
|
(liftIO . setCurrentDirectory) a
|
||||||
|
|
||||||
|
swapCurrentDirectory ndir = do
|
||||||
|
odir <- canonicalizePath =<< getCurrentDirectory
|
||||||
|
setCurrentDirectory ndir
|
||||||
|
return odir
|
||||||
|
|
||||||
gbracket_ ma mb mc = gbracket ma mb (const mc)
|
gbracket_ ma mb mc = gbracket ma mb (const mc)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user