Drop memory-mapped files, since ghc doesn't play well with those

All files are now "redirected", either user-created, or created by ghc-mod itself.

Language/Haskell/GhcMod/FileMapping.hs

@@ -1,5 +1,6 @@
 module Language.Haskell.GhcMod.FileMapping
     ( loadMappedFile
+    , loadMappedFileSource
     , unloadMappedFile
     , mapFile
     , fileModSummaryWithMapping
@@ -11,43 +12,55 @@ import Language.Haskell.GhcMod.Gap
 import Language.Haskell.GhcMod.HomeModuleGraph
 import Language.Haskell.GhcMod.Utils
 
-import Data.Time
+import System.IO
+import System.FilePath
+import System.Directory
 
 import Control.Monad.Trans.Maybe
 import GHC
+import Control.Monad
+import Control.Monad.Trans (lift)
 
-loadMappedFile :: IOish m => FilePath -> FileMapping -> GhcModT m ()
-loadMappedFile from fm =
-  getCanonicalFileNameSafe from >>= (`addMMappedFile` fm)
+loadMappedFile :: IOish m => FilePath -> FilePath -> GhcModT m ()
+loadMappedFile from to =
+  getCanonicalFileNameSafe from >>= (`addMMappedFile` FileMapping to False)
 
-mapFile :: (IOish m, GmState m, GhcMonad m) =>
+loadMappedFileSource :: IOish m => FilePath -> String -> GhcModT m ()
+loadMappedFileSource from src = do
+  tmpdir <- cradleTempDir `fmap` cradle
+  to <- liftIO $ do
+    (fn, h) <- openTempFile tmpdir (takeFileName from)
+    hPutStr h src
+    hClose h
+    return fn
+  getCanonicalFileNameSafe from >>= (`addMMappedFile` FileMapping to True)
+
+mapFile :: (IOish m, GmState m, GhcMonad m, GmEnv m) =>
             HscEnv -> Target -> m Target
 mapFile _ (Target tid@(TargetFile filePath _) taoc _) = do
   mapping <- lookupMMappedFile filePath
-  mkMappedTarget tid taoc mapping
+  mkMappedTarget (Just filePath) tid taoc mapping
 mapFile env (Target tid@(TargetModule moduleName) taoc _) = do
-  mapping <- runMaybeT $ do
-    filePath <- MaybeT $ liftIO $ findModulePath env moduleName
-    MaybeT $ lookupMMappedFile $ mpPath filePath
-  mkMappedTarget tid taoc mapping
+  (fp, mapping) <- do
+    filePath <- fmap (fmap mpPath) (liftIO $ findModulePath env moduleName)
+    mmf <- runMaybeT $ MaybeT (return filePath) >>= MaybeT . lookupMMappedFile
+    return (filePath, mmf)
+  mkMappedTarget fp tid taoc mapping
 
-mkMappedTarget :: (IOish m, GmState m, GhcMonad m) =>
-                  TargetId -> Bool -> Maybe FileMapping -> m Target
-mkMappedTarget _ taoc (Just (RedirectedMapping to)) =
-  return $ mkTarget (TargetFile to Nothing) taoc Nothing
-mkMappedTarget tid taoc (Just (MemoryMapping (Just src))) = do
-  sb <- toStringBuffer [src]
-  ct <- liftIO getCurrentTime
-  return $ mkTarget tid taoc $ Just (sb, ct)
-mkMappedTarget tid taoc _ = return $ mkTarget tid taoc Nothing
+mkMappedTarget :: (IOish m, GmState m, GmEnv m, GhcMonad m) =>
+                  Maybe FilePath -> TargetId -> Bool -> Maybe FileMapping -> m Target
+mkMappedTarget _ _ taoc (Just to) =
+  return $ mkTarget (TargetFile (fmPath to) Nothing) taoc Nothing
+mkMappedTarget _ tid taoc _ = return $ mkTarget tid taoc Nothing
 
 unloadMappedFile :: IOish m => FilePath -> GhcModT m ()
-unloadMappedFile = (delMMappedFile =<<) . getCanonicalFileNameSafe
+unloadMappedFile what = void $ runMaybeT $ do
+  cfn <- lift $ getCanonicalFileNameSafe what
+  fm <- MaybeT $ lookupMMappedFile cfn
+  liftIO $ when (fmTemp fm) $ removeFile (fmPath fm)
+  delMMappedFile cfn
 
 fileModSummaryWithMapping :: (IOish m, GmState m, GhcMonad m, GmEnv m) =>
                             FilePath -> m ModSummary
-fileModSummaryWithMapping fn = do
-  mmf <- getCanonicalFileNameSafe fn >>= lookupMMappedFile
-  case mmf of
-    Just (RedirectedMapping to) -> fileModSummary to
-    _                           -> fileModSummary fn
+fileModSummaryWithMapping fn =
+  withMappedFile fn $ \fn' -> fileModSummary fn'