ghc-mod/core/Language/Haskell/GhcMod/FileMapping.hs

105 lines
3.5 KiB
Haskell
Raw Normal View History

module Language.Haskell.GhcMod.FileMapping
( loadMappedFile
, loadMappedFileSource
2015-06-09 09:45:27 +00:00
, unloadMappedFile
, mapFile
2015-07-03 19:31:52 +00:00
, fileModSummaryWithMapping
) where
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.HomeModuleGraph
import Language.Haskell.GhcMod.Utils
import System.IO
import System.FilePath
import System.Directory
import Control.Monad.Trans.Maybe
import GHC
import Control.Monad
2015-12-20 10:45:51 +00:00
{- | maps 'FilePath', given as first argument to take source from
'FilePath' given as second argument. Works exactly the same as
first form of `--map-file` CLI option.
\'from\' can be either full path, or path relative to project root.
\'to\' has to be either relative to project root, or full path (preferred)
-}
loadMappedFile :: IOish m
=> FilePath -- ^ \'from\', file that will be mapped
-> FilePath -- ^ \'to\', file to take source from
-> GhcModT m ()
2015-08-16 20:38:32 +00:00
loadMappedFile from to = loadMappedFile' from to False
2015-12-20 10:45:51 +00:00
{- |
maps 'FilePath', given as first argument to have source as given
by second argument.
\'from\' may or may not exist, and should be either full path,
or relative to project root.
-}
loadMappedFileSource :: IOish m
=> FilePath -- ^ \'from\', file that will be mapped
-> String -- ^ \'src\', source
-> GhcModT m ()
loadMappedFileSource from src = do
tmpdir <- cradleTempDir `fmap` cradle
enc <- liftIO . mkTextEncoding . optEncoding =<< options
to <- liftIO $ do
(fn, h) <- openTempFile tmpdir (takeFileName from)
hSetEncoding h enc
hPutStr h src
hClose h
return fn
2015-08-16 20:38:32 +00:00
loadMappedFile' from to True
loadMappedFile' :: IOish m => FilePath -> FilePath -> Bool -> GhcModT m ()
loadMappedFile' from to isTemp = do
cfn <- getCanonicalFileNameSafe from
unloadMappedFile' cfn
crdl <- cradle
let to' = makeRelative (cradleRootDir crdl) to
addMMappedFile cfn (FileMapping to' isTemp)
mapFile :: (IOish m, GmState m) => HscEnv -> Target -> m Target
mapFile _ (Target tid@(TargetFile filePath _) taoc _) = do
mapping <- lookupMMappedFile filePath
return $ mkMappedTarget (Just filePath) tid taoc mapping
mapFile env (Target tid@(TargetModule moduleName) taoc _) = do
(fp, mapping) <- do
filePath <- fmap (fmap mpPath) (liftIO $ findModulePath env moduleName)
mmf <- runMaybeT $ MaybeT (return filePath) >>= MaybeT . lookupMMappedFile
return (filePath, mmf)
return $ mkMappedTarget fp tid taoc mapping
mkMappedTarget :: Maybe FilePath -> TargetId -> Bool -> Maybe FileMapping -> Target
mkMappedTarget _ _ taoc (Just to) =
mkTarget (TargetFile (fmPath to) Nothing) taoc Nothing
mkMappedTarget _ tid taoc _ =
mkTarget tid taoc Nothing
2015-06-09 09:45:27 +00:00
2015-12-20 10:45:51 +00:00
{-|
unloads previously mapped file \'file\', so that it's no longer mapped,
and removes any temporary files created when file was
mapped.
\'file\' should be either full path, or relative to project root.
-}
unloadMappedFile :: IOish m
=> FilePath -- ^ \'file\', file to unmap
-> GhcModT m ()
2015-08-16 20:38:32 +00:00
unloadMappedFile = getCanonicalFileNameSafe >=> unloadMappedFile'
unloadMappedFile' :: IOish m => FilePath -> GhcModT m ()
unloadMappedFile' cfn = void $ runMaybeT $ do
fm <- MaybeT $ lookupMMappedFile cfn
liftIO $ when (fmTemp fm) $ removeFile (fmPath fm)
delMMappedFile cfn
2015-07-03 19:31:52 +00:00
fileModSummaryWithMapping :: (IOish m, GmState m, GhcMonad m, GmEnv m) =>
FilePath -> m ModSummary
fileModSummaryWithMapping fn =
withMappedFile fn $ \fn' -> fileModSummary fn'