GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-27 03:38:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

GF.Compile.ReadFiles: reduced code duplication

Browse Source
This commit is contained in:
hallgren
2013-12-16 14:04:57 +00:00
parent 665603c248
commit 9812c6ff90
2 changed files with 11 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
src/compiler/GF/Compile/ReadFiles.hs
View File

@@ -43,9 +43,8 @@ import Control.Monad
import Data.Maybe(isJust) import Data.Maybe(isJust)
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Time import Data.Time(UTCTime)
import Data.Time.Compat (toUTCTime) import GF.System.Directory
import System.Directory
import System.FilePath import System.FilePath
import Text.PrettyPrint import Text.PrettyPrint
@@ -58,8 +57,8 @@ type ModEnv = Map.Map ModName (UTCTime,[ModName])
--getAllFiles :: (MonadIO m,ErrorMonad m) => Options -> [InitPath] -> ModEnv -> FileName -> m [FullPath] --getAllFiles :: (MonadIO m,ErrorMonad m) => Options -> [InitPath] -> ModEnv -> FileName -> m [FullPath]
getAllFiles opts ps env file = do getAllFiles opts ps env file = do
-- read module headers from all files recursively -- read module headers from all files recursively
ds <- liftM reverse $ get [] [] (justModuleName file) ds <- reverse `fmap` get [] [] (justModuleName file)
liftIO $ putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_,_) <- ds] putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_,_) <- ds]
return $ paths ds return $ paths ds
where where
-- construct list of paths to read -- construct list of paths to read
@@ -99,13 +98,12 @@ getAllFiles opts ps env file = do
(file,gfTime,gfoTime) <- do (file,gfTime,gfoTime) <- do
mb_gfFile <- getFilePath ps (gfFile name) mb_gfFile <- getFilePath ps (gfFile name)
case mb_gfFile of case mb_gfFile of
Just gfFile -> do gfTime <- liftIO $ toUTCTime `fmap` getModificationTime gfFile Just gfFile -> do gfTime <- modtime gfFile
mb_gfoTime <- liftIO $ catch (liftM Just $ toUTCTime `fmap` getModificationTime (gf2gfo opts gfFile)) mb_gfoTime <- maybeIO $ modtime (gf2gfo opts gfFile)
(\_->return Nothing)
return (gfFile, Just gfTime, mb_gfoTime) return (gfFile, Just gfTime, mb_gfoTime)
Nothing -> do mb_gfoFile <- getFilePath (maybe id (:) (flag optGFODir opts) ps) (gfoFile name) Nothing -> do mb_gfoFile <- getFilePath (maybe id (:) (flag optGFODir opts) ps) (gfoFile name)
case mb_gfoFile of case mb_gfoFile of
Just gfoFile -> do gfoTime <- liftIO $ toUTCTime `fmap` getModificationTime gfoFile Just gfoFile -> do gfoTime <- modtime gfoFile
return (gfoFile, Nothing, Just gfoTime) return (gfoFile, Nothing, Just gfoTime)
Nothing -> raise (render (text "File" <+> text (gfFile name) <+> text "does not exist." $$ Nothing -> raise (render (text "File" <+> text (gfFile name) <+> text "does not exist." $$
text "searched in:" <+> vcat (map text ps))) text "searched in:" <+> vcat (map text ps)))
@@ -130,6 +128,8 @@ getAllFiles opts ps env file = do
("module name" +++ mname +++ "differs from file name" +++ name) ("module name" +++ mname +++ "differs from file name" +++ name)
return (name,st,t,isJust gfTime,imps,dropFileName file) return (name,st,t,isJust gfTime,imps,dropFileName file)
modtime path = liftIO $ getModificationTime path
isGFO :: FilePath -> Bool isGFO :: FilePath -> Bool
isGFO = (== ".gfo") . takeExtensions isGFO = (== ".gfo") . takeExtensions

2
src/compiler/GF/Infra/UseIO.hs
View File

@@ -139,6 +139,8 @@ instance Monad IOE where
appIOE $ err raise f x -- f :: a -> IOE a appIOE $ err raise f x -- f :: a -> IOE a
fail = raise fail = raise
maybeIO io = either (const Nothing) Just `fmap` liftIO (try io)
useIOE :: a -> IOE a -> IO a useIOE :: a -> IOE a -> IO a
useIOE a ioe = appIOE ioe >>= err (\s -> putStrLn s >> return a) return useIOE a ioe = appIOE ioe >>= err (\s -> putStrLn s >> return a) return