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

4 files changed, 23 insertions, 11 deletions

diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index 8d842e2ca..ffa0f0b0a 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -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)
diff --git a/src/compiler/GF/Compile/ReadFiles.hs b/src/compiler/GF/Compile/ReadFiles.hs
index ecbd88b54..4e57e5ba4 100644
--- a/src/compiler/GF/Compile/ReadFiles.hs
+++ b/src/compiler/GF/Compile/ReadFiles.hs
@@ -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
 
diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs
index 31a0f81df..c99430079 100644
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -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
diff --git a/src/compiler/GF/System/Directory.hs b/src/compiler/GF/System/Directory.hs
index 3ee1f3550..3cd8a8ef6 100644
--- a/src/compiler/GF/System/Directory.hs
+++ b/src/compiler/GF/System/Directory.hs
@@ -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
\ No newline at end of file