Unload mapped files before loading

This commit is contained in:
Nikolay Yakimov 2015-08-16 23:38:32 +03:00
parent e0044a3697
commit 8ef8a86397

View File

@ -19,11 +19,9 @@ import System.Directory
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import GHC import GHC
import Control.Monad import Control.Monad
import Control.Monad.Trans (lift)
loadMappedFile :: IOish m => FilePath -> FilePath -> GhcModT m () loadMappedFile :: IOish m => FilePath -> FilePath -> GhcModT m ()
loadMappedFile from to = loadMappedFile from to = loadMappedFile' from to False
getCanonicalFileNameSafe from >>= (`addMMappedFile` FileMapping to False)
loadMappedFileSource :: IOish m => FilePath -> String -> GhcModT m () loadMappedFileSource :: IOish m => FilePath -> String -> GhcModT m ()
loadMappedFileSource from src = do loadMappedFileSource from src = do
@ -33,7 +31,13 @@ loadMappedFileSource from src = do
hPutStr h src hPutStr h src
hClose h hClose h
return fn return fn
getCanonicalFileNameSafe from >>= (`addMMappedFile` FileMapping to True) loadMappedFile' from to True
loadMappedFile' :: IOish m => FilePath -> FilePath -> Bool -> GhcModT m ()
loadMappedFile' from to isTemp = do
cfn <- getCanonicalFileNameSafe from
unloadMappedFile' cfn
addMMappedFile cfn (FileMapping to isTemp)
mapFile :: (IOish m, GmState m, GhcMonad m, GmEnv m) => mapFile :: (IOish m, GmState m, GhcMonad m, GmEnv m) =>
HscEnv -> Target -> m Target HscEnv -> Target -> m Target
@ -54,8 +58,10 @@ mkMappedTarget _ _ taoc (Just to) =
mkMappedTarget _ tid taoc _ = return $ mkTarget tid taoc Nothing mkMappedTarget _ tid taoc _ = return $ mkTarget tid taoc Nothing
unloadMappedFile :: IOish m => FilePath -> GhcModT m () unloadMappedFile :: IOish m => FilePath -> GhcModT m ()
unloadMappedFile what = void $ runMaybeT $ do unloadMappedFile = getCanonicalFileNameSafe >=> unloadMappedFile'
cfn <- lift $ getCanonicalFileNameSafe what
unloadMappedFile' :: IOish m => FilePath -> GhcModT m ()
unloadMappedFile' cfn = void $ runMaybeT $ do
fm <- MaybeT $ lookupMMappedFile cfn fm <- MaybeT $ lookupMMappedFile cfn
liftIO $ when (fmTemp fm) $ removeFile (fmPath fm) liftIO $ when (fmTemp fm) $ removeFile (fmPath fm)
delMMappedFile cfn delMMappedFile cfn