diff options
| -rw-r--r-- | src/compiler/GF/Compile.hs | 8 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/ReadFiles.hs | 2 | ||||
| -rw-r--r-- | src/compiler/GF/CompileOne.hs | 6 | ||||
| -rw-r--r-- | src/compiler/GF/System/Directory.hs | 18 | ||||
| -rw-r--r-- | src/compiler/GFServer.hs | 14 |
5 files changed, 30 insertions, 18 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 diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs index f0c120b9c..049891b54 100644 --- a/src/compiler/GFServer.hs +++ b/src/compiler/GFServer.hs @@ -190,8 +190,8 @@ handle logLn documentroot state0 cache execute1 stateVar inDir ok = cd =<< look "dir" where cd ('/':dir@('t':'m':'p':_)) = - do cwd <- liftIO $ getCurrentDirectory - b <- liftIO $ doesDirectoryExist dir + do cwd <- getCurrentDirectory + b <- doesDirectoryExist dir case b of False -> do b <- liftIO $ try $ readFile dir -- poor man's symbolic links case b of @@ -247,7 +247,7 @@ handle logLn documentroot state0 cache execute1 stateVar logPutStrLn cmd out@(ecode,_,_) <- liftIO $ readProcessWithExitCode "gf" args "" logPutStrLn $ show ecode - cwd <- liftIO $ getCurrentDirectory + cwd <- getCurrentDirectory return $ json200 (jsonresult cwd ('/':dir++"/") cmd out files) upload skip files = @@ -265,15 +265,15 @@ handle logLn documentroot state0 cache execute1 stateVar jsonList' details ext = fmap (json200) (details =<< ls_ext "." ext) addTime path = - do t <- liftIO $ getModificationTime path + do t <- getModificationTime path return $ makeObj ["path".=path,"time".=format t] where format = formatTime defaultTimeLocale rfc822DateFormat rm path | takeExtension path `elem` ok_to_delete = - do b <- liftIO $ doesFileExist path + do b <- doesFileExist path if b - then do liftIO $ removeFile path + then do removeFile path return $ ok200 "" else err $ resp404 path rm path = err $ resp400 $ "unacceptable extension "++path @@ -306,7 +306,7 @@ handle logLn documentroot state0 cache execute1 stateVar return $ jsonp qs pgfs ls_ext dir ext = - do paths <- liftIO $ getDirectoryContents dir + do paths <- getDirectoryContents dir return [path | path<-paths, takeExtension path==ext] -- * Dynamic content |