Add FileMapping support to HMG/preprocessFile
Post-rebase update
This commit is contained in:
parent
70d2a4704b
commit
654b172f5e
@ -54,12 +54,15 @@ import Data.Set (Set)
|
|||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
import System.IO
|
||||||
|
import System.IO.Temp
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Language.Haskell.GhcMod.Logging
|
import Language.Haskell.GhcMod.Logging
|
||||||
import Language.Haskell.GhcMod.Logger
|
import Language.Haskell.GhcMod.Logger
|
||||||
import Language.Haskell.GhcMod.Monad.Types
|
import Language.Haskell.GhcMod.Monad.Types
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
|
import Language.Haskell.GhcMod.Utils (getMappedFileSource)
|
||||||
import Language.Haskell.GhcMod.Gap (parseModuleHeader)
|
import Language.Haskell.GhcMod.Gap (parseModuleHeader)
|
||||||
|
|
||||||
-- | Turn module graph into a graphviz dot file
|
-- | 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)))
|
HscEnv -> FilePath -> m (Either [String] ([String], (DynFlags, FilePath)))
|
||||||
preprocessFile env file =
|
preprocessFile env file =
|
||||||
withLogger' env $ \setDf -> do
|
withLogger' env $ \setDf -> do
|
||||||
|
src <- runMaybeT $ getMappedFileSource file
|
||||||
let env' = env { hsc_dflags = setDf (hsc_dflags env) }
|
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) =>
|
fileModuleName :: (IOish m, GmEnv m, GmState m) =>
|
||||||
HscEnv -> FilePath -> m (Either [String] (Maybe ModuleName))
|
HscEnv -> FilePath -> m (Either [String] (Maybe ModuleName))
|
||||||
|
@ -44,6 +44,7 @@ import Text.Printf
|
|||||||
import Paths_ghc_mod (getLibexecDir)
|
import Paths_ghc_mod (getLibexecDir)
|
||||||
import Utils
|
import Utils
|
||||||
import Prelude
|
import Prelude
|
||||||
|
import Control.Monad.Trans.Maybe
|
||||||
|
|
||||||
-- dropWhileEnd is not provided prior to base 4.5.0.0.
|
-- dropWhileEnd is not provided prior to base 4.5.0.0.
|
||||||
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
|
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
|
||||||
@ -186,6 +187,14 @@ getCanonicalFileNameSafe fn = do
|
|||||||
then liftIO $ canonicalizePath ccfn
|
then liftIO $ canonicalizePath ccfn
|
||||||
else return 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 :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath)
|
||||||
mkRevRedirMapFunc = do
|
mkRevRedirMapFunc = do
|
||||||
rm <- M.fromList <$> mapMaybe (uncurry mf) <$> M.toList <$> getMMappedFiles
|
rm <- M.fromList <$> mapMaybe (uncurry mf) <$> M.toList <$> getMMappedFiles
|
||||||
|
Loading…
Reference in New Issue
Block a user