From 654b172f5ed4c002b039090a0172d1d07a49ff11 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Sun, 16 Aug 2015 18:22:27 +0300
Subject: [PATCH] Add FileMapping support to HMG/preprocessFile

Post-rebase update
---
 Language/Haskell/GhcMod/HomeModuleGraph.hs | 16 +++++++++++++++-
 Language/Haskell/GhcMod/Utils.hs           |  9 +++++++++
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/Language/Haskell/GhcMod/HomeModuleGraph.hs b/Language/Haskell/GhcMod/HomeModuleGraph.hs
index f9e6577..1272f4e 100644
--- a/Language/Haskell/GhcMod/HomeModuleGraph.hs
+++ b/Language/Haskell/GhcMod/HomeModuleGraph.hs
@@ -54,12 +54,15 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import System.FilePath
 import System.Directory
+import System.IO
+import System.IO.Temp
 import Prelude
 
 import Language.Haskell.GhcMod.Logging
 import Language.Haskell.GhcMod.Logger
 import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Utils (getMappedFileSource)
 import Language.Haskell.GhcMod.Gap (parseModuleHeader)
 
 -- | Turn module graph into a graphviz dot file
@@ -244,8 +247,19 @@ preprocessFile :: (IOish m, GmEnv m, GmState m) =>
   HscEnv -> FilePath -> m (Either [String] ([String], (DynFlags, FilePath)))
 preprocessFile env file =
   withLogger' env $ \setDf -> do
+    src <- runMaybeT $ getMappedFileSource file
     let env' = env { hsc_dflags = setDf (hsc_dflags env) }
-    liftIO $ preprocess env' (file, Nothing)
+    maybe
+      (liftIO $ preprocess env' (file, Nothing))
+      (preprocessWithTemp env' file)
+      src
+  where
+    preprocessWithTemp env' fn src = do
+      tmpdir <- cradleTempDir <$> cradle
+      liftIO $ withTempFile tmpdir fn $ \fn' hndl -> do
+        hPutStr hndl src
+        hClose hndl
+        preprocess env' (fn', Nothing)
 
 fileModuleName :: (IOish m, GmEnv m, GmState m) =>
   HscEnv -> FilePath -> m (Either [String] (Maybe ModuleName))
diff --git a/Language/Haskell/GhcMod/Utils.hs b/Language/Haskell/GhcMod/Utils.hs
index c4f2710..74b3e49 100644
--- a/Language/Haskell/GhcMod/Utils.hs
+++ b/Language/Haskell/GhcMod/Utils.hs
@@ -44,6 +44,7 @@ import Text.Printf
 import Paths_ghc_mod (getLibexecDir)
 import Utils
 import Prelude
+import Control.Monad.Trans.Maybe
 
 -- dropWhileEnd is not provided prior to base 4.5.0.0.
 dropWhileEnd :: (a -> Bool) -> [a] -> [a]
@@ -186,6 +187,14 @@ getCanonicalFileNameSafe fn = do
     then liftIO $ canonicalizePath ccfn
     else return ccfn
 
+getMappedFileSource :: (IOish m, GmEnv m, GmState m) => FilePath -> MaybeT m String
+getMappedFileSource fn = do
+  mf <- MaybeT $ getCanonicalFileNameSafe fn >>= lookupMMappedFile
+  case mf of
+    RedirectedMapping fn' -> liftIO $ readFile fn'
+    MemoryMapping (Just src) -> return src
+    _ -> mzero
+
 mkRevRedirMapFunc :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath)
 mkRevRedirMapFunc = do
   rm <- M.fromList <$> mapMaybe (uncurry mf) <$> M.toList <$> getMMappedFiles