Move withMappedFile to Language.Haskell.GhcMod.Utils

This commit is contained in:
Nikolay Yakimov 2015-07-03 06:43:32 +03:00
parent d405ce7efa
commit 31020c4112
5 changed files with 21 additions and 27 deletions

View File

@ -1,22 +0,0 @@
module Language.Haskell.GhcMod.FileMappingUtils where
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad.Types
import System.IO
import System.FilePath
import System.Directory
withMappedFile :: (IOish m, GmState m, GmEnv m) => forall a. FilePath -> (FilePath -> m a) -> m a
withMappedFile file action = lookupMMappedFile file >>= runWithFile
where
runWithFile (Just (RedirectedMapping to)) = action to
runWithFile (Just (MemoryMapping (Just src))) = do
crdl <- cradle
(fp,hndl) <- liftIO $ openTempFile (cradleTempDir crdl) (takeBaseName file)
liftIO $ hPutStr hndl src
liftIO $ hClose hndl
result <- action fp
liftIO $ removeFile fp
return result
runWithFile _ = action file

View File

@ -61,7 +61,7 @@ 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.Gap (parseModuleHeader) import Language.Haskell.GhcMod.Gap (parseModuleHeader)
import Language.Haskell.GhcMod.FileMappingUtils import Language.Haskell.GhcMod.Utils (withMappedFile)
-- | Turn module graph into a graphviz dot file -- | Turn module graph into a graphviz dot file
-- --

View File

@ -8,7 +8,7 @@ import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.HLint (hlint) import Language.Haskell.HLint (hlint)
import Language.Haskell.GhcMod.FileMappingUtils import Language.Haskell.GhcMod.Utils (withMappedFile)
import Data.List (stripPrefix) import Data.List (stripPrefix)

View File

@ -27,13 +27,15 @@ import Control.Applicative
import Data.Char import Data.Char
import Exception import Exception
import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.Monad.Types
import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist, import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist,
getTemporaryDirectory, canonicalizePath) getTemporaryDirectory, canonicalizePath, removeFile)
import System.Environment import System.Environment
import System.FilePath (splitDrive, takeDirectory, takeFileName, pathSeparators, import System.FilePath (splitDrive, takeDirectory, takeFileName, pathSeparators,
(</>)) (</>))
import System.IO.Temp (createTempDirectory) import System.IO.Temp (createTempDirectory, openTempFile)
import System.IO (hPutStr, hClose)
import System.Process (readProcess) import System.Process (readProcess)
import Text.Printf import Text.Printf
@ -157,3 +159,18 @@ canonFilePath f = do
e <- doesFileExist p e <- doesFileExist p
when (not e) $ error $ "canonFilePath: not a file: " ++ p when (not e) $ error $ "canonFilePath: not a file: " ++ p
return p return p
withMappedFile :: (IOish m, GmState m, GmEnv m) =>
forall a. FilePath -> (FilePath -> m a) -> m a
withMappedFile file action = lookupMMappedFile file >>= runWithFile
where
runWithFile (Just (RedirectedMapping to)) = action to
runWithFile (Just (MemoryMapping (Just src))) = do
crdl <- cradle
(fp,hndl) <- liftIO $ openTempFile (cradleTempDir crdl) (takeFileName file)
liftIO $ hPutStr hndl src
liftIO $ hClose hndl
result <- action fp
liftIO $ removeFile fp
return result
runWithFile _ = action file

View File

@ -106,7 +106,6 @@ Library
Language.Haskell.GhcMod.DynFlags Language.Haskell.GhcMod.DynFlags
Language.Haskell.GhcMod.Error Language.Haskell.GhcMod.Error
Language.Haskell.GhcMod.FileMapping Language.Haskell.GhcMod.FileMapping
Language.Haskell.GhcMod.FileMappingUtils
Language.Haskell.GhcMod.FillSig Language.Haskell.GhcMod.FillSig
Language.Haskell.GhcMod.Find Language.Haskell.GhcMod.Find
Language.Haskell.GhcMod.Flag Language.Haskell.GhcMod.Flag