1
0
forked from GitHub/gf-core

Add lifted directory operations in GF.System.Directory to eliminate the need for liftIO in various places

This commit is contained in:
hallgren
2014-08-20 17:47:08 +00:00
parent 73310add9a
commit 21f429caf8
5 changed files with 30 additions and 18 deletions

View File

@@ -51,7 +51,7 @@ batchCompile opts files = do
-- to compile a set of modules, e.g. an old GF or a .cf file
compileSourceGrammar :: Options -> SourceGrammar -> IOE SourceGrammar
compileSourceGrammar opts gr = do
cwd <- liftIO getCurrentDirectory
cwd <- getCurrentDirectory
(_,gr',_) <- foldM (\env -> compileSourceModule opts cwd env Nothing)
emptyCompileEnv
(modules gr)
@@ -81,13 +81,13 @@ compileModule opts1 env@(_,rfs) file =
foldM (compileOne' opts) env files
where
getRealFile file = do
exists <- liftIO $ doesFileExist file
exists <- doesFileExist file
if exists
then return file
else if isRelative file
then do lib_dir <- getLibraryDirectory opts1
let file1 = lib_dir </> file
exists <- liftIO $ doesFileExist file1
exists <- doesFileExist file1
if exists
then return file1
else raise (render ("None of these files exists:" $$ nest 2 (file $$ file1)))
@@ -108,7 +108,7 @@ extendCompileEnv (gr,menv) (mfile,mo) =
do menv2 <- case mfile of
Just file ->
do let (mod,imps) = importsOfModule mo
t <- liftIO $ getModificationTime file
t <- getModificationTime file
return $ Map.insert mod (t,imps) menv
_ -> return menv
return (prependModule gr mo,menv2)

View File

@@ -139,7 +139,7 @@ findFile gfoDir ps name =
noGFO = raise (render ("File" <+> gfFile name <+> "does not exist." $$
"searched in:" <+> vcat ps))
modtime path = liftIO $ getModificationTime path
modtime path = getModificationTime path
gfImports opts file = importsOfModule `fmap` parseModHeader opts file

View File

@@ -37,7 +37,7 @@ compileOne :: Options -> SourceGrammar -> FullPath -> IOE OneOutput
compileOne opts srcgr file =
if isGFO file
then reuseGFO opts srcgr file
else do b1 <- liftIO $ doesFileExist file
else do b1 <- doesFileExist file
if b1 then useTheSource
else reuseGFO opts srcgr (gf2gfo opts file)
where
@@ -47,7 +47,7 @@ compileOne opts srcgr file =
("- compiling" +++ file ++ "... ")
(getSourceModule opts file)
idump opts Source sm
cwd <- liftIO getCurrentDirectory
cwd <- getCurrentDirectory
compileSourceModule opts cwd (Just file) srcgr sm
putpOpt v m act
@@ -65,7 +65,7 @@ reuseGFO opts srcgr file =
idump opts Source sm0
let sm1 = unsubexpModule sm0
cwd <- liftIO getCurrentDirectory
cwd <- getCurrentDirectory
(sm,warnings) <- -- putPointE Normal opts "creating indirections" $
runCheck $ extendModule cwd srcgr sm1
warnOut opts warnings

View File

@@ -1,7 +1,19 @@
-- | Isolate backwards incompatible library changes to 'getModificationTime'
module GF.System.Directory(getModificationTime,module D) where
-- and provide lifted versions of some directory operations
module GF.System.Directory(module GF.System.Directory,module D) where
import Control.Monad.Trans(MonadIO(..))
import qualified System.Directory as D
import System.Directory as D hiding (getModificationTime)
import System.Directory as D
hiding (doesDirectoryExist,doesFileExist,getModificationTime,
getCurrentDirectory,getDirectoryContents,removeFile)
import Data.Time.Compat
getModificationTime path = fmap toUTCTime (D.getModificationTime path)
doesDirectoryExist path = liftIO $ D.doesDirectoryExist path
doesFileExist path = liftIO $ D.doesFileExist path
getModificationTime path = liftIO $ fmap toUTCTime (D.getModificationTime path)
getDirectoryContents path = liftIO $ D.getDirectoryContents path
getCurrentDirectory :: MonadIO io => io FilePath
getCurrentDirectory = liftIO D.getCurrentDirectory
removeFile path = liftIO $ D.removeFile path