mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 03:32:51 -06:00
some dead code elimination in UseIO and ReadFiles
This commit is contained in:
@@ -88,13 +88,13 @@ getAllFiles opts ps env file = do
|
|||||||
findModule :: ModName -> IOE ModuleInfo
|
findModule :: ModName -> IOE ModuleInfo
|
||||||
findModule name = do
|
findModule name = do
|
||||||
(file,gfTime,gfoTime) <- do
|
(file,gfTime,gfoTime) <- do
|
||||||
mb_gfFile <- ioeIO $ getFilePathMsg "" ps (gfFile name)
|
mb_gfFile <- ioeIO $ getFilePath ps (gfFile name)
|
||||||
case mb_gfFile of
|
case mb_gfFile of
|
||||||
Just gfFile -> do gfTime <- ioeIO $ getModificationTime gfFile
|
Just gfFile -> do gfTime <- ioeIO $ getModificationTime gfFile
|
||||||
mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (replaceExtension gfFile "gfo"))
|
mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (replaceExtension gfFile "gfo"))
|
||||||
(\_->return Nothing)
|
(\_->return Nothing)
|
||||||
return (gfFile, Just gfTime, mb_gfoTime)
|
return (gfFile, Just gfTime, mb_gfoTime)
|
||||||
Nothing -> do mb_gfoFile <- ioeIO $ getFilePathMsg "" ps (gfoFile name)
|
Nothing -> do mb_gfoFile <- ioeIO $ getFilePath ps (gfoFile name)
|
||||||
case mb_gfoFile of
|
case mb_gfoFile of
|
||||||
Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile
|
Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile
|
||||||
return (gfoFile, Nothing, Just gfoTime)
|
return (gfoFile, Nothing, Just gfoTime)
|
||||||
@@ -212,7 +212,20 @@ importsOfModule (m,mi) = (modName m,depModInfo mi [])
|
|||||||
-- | options can be passed to the compiler by comments in @--#@, in the main file
|
-- | options can be passed to the compiler by comments in @--#@, in the main file
|
||||||
getOptionsFromFile :: FilePath -> IOE Options
|
getOptionsFromFile :: FilePath -> IOE Options
|
||||||
getOptionsFromFile file = do
|
getOptionsFromFile file = do
|
||||||
s <- ioeIO $ readFileIfStrict file
|
s <- ioe $ catch (fmap Ok $ BS.readFile file)
|
||||||
|
(\_ -> return (Bad $ "File " ++ file ++ " does not exist"))
|
||||||
let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
|
let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
|
||||||
fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
|
fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
|
||||||
ioeErr $ parseModuleOptions fs
|
ioeErr $ parseModuleOptions fs
|
||||||
|
|
||||||
|
getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
|
||||||
|
getFilePath paths file = get paths
|
||||||
|
where
|
||||||
|
get [] = return Nothing
|
||||||
|
get (p:ps) = do
|
||||||
|
let pfile = p </> file
|
||||||
|
exist <- doesFileExist pfile
|
||||||
|
if not exist
|
||||||
|
then get ps
|
||||||
|
else do pfile <- canonicalizePath pfile
|
||||||
|
return (Just pfile)
|
||||||
|
|||||||
@@ -32,7 +32,6 @@ import GF.Grammar.Unify ---
|
|||||||
import GF.Compile.TC
|
import GF.Compile.TC
|
||||||
|
|
||||||
import Control.Monad (foldM, liftM, liftM2)
|
import Control.Monad (foldM, liftM, liftM2)
|
||||||
import Data.List (nub) ---
|
|
||||||
|
|
||||||
-- | invariant way of creating TCEnv from context
|
-- | invariant way of creating TCEnv from context
|
||||||
initTCEnv gamma =
|
initTCEnv gamma =
|
||||||
|
|||||||
@@ -21,7 +21,7 @@ module GF.Data.Operations (-- * misc functions
|
|||||||
Err(..), err, maybeErr, testErr, errVal, errIn,
|
Err(..), err, maybeErr, testErr, errVal, errIn,
|
||||||
lookupErr,
|
lookupErr,
|
||||||
mapPairListM, mapPairsM, pairM,
|
mapPairListM, mapPairsM, pairM,
|
||||||
(!?), singleton, mapsErr, mapsErrTree,
|
singleton, mapsErr, mapsErrTree,
|
||||||
|
|
||||||
-- ** checking
|
-- ** checking
|
||||||
checkUnique,
|
checkUnique,
|
||||||
@@ -77,7 +77,6 @@ infixr 5 +++
|
|||||||
infixr 5 ++-
|
infixr 5 ++-
|
||||||
infixr 5 ++++
|
infixr 5 ++++
|
||||||
infixr 5 +++++
|
infixr 5 +++++
|
||||||
infixl 9 !?
|
|
||||||
|
|
||||||
ifNull :: b -> ([a] -> b) -> [a] -> b
|
ifNull :: b -> ([a] -> b) -> [a] -> b
|
||||||
ifNull b f xs = if null xs then b else f xs
|
ifNull b f xs = if null xs then b else f xs
|
||||||
@@ -118,10 +117,6 @@ mapPairsM f xys = mapM (\ (x,y) -> liftM ((,) x) (f y)) xys
|
|||||||
pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c)
|
pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c)
|
||||||
pairM op (t1,t2) = liftM2 (,) (op t1) (op t2)
|
pairM op (t1,t2) = liftM2 (,) (op t1) (op t2)
|
||||||
|
|
||||||
-- @!!@ with the error monad
|
|
||||||
(!?) :: [a] -> Int -> Err a
|
|
||||||
xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs
|
|
||||||
|
|
||||||
singleton :: a -> [a]
|
singleton :: a -> [a]
|
||||||
singleton = (:[])
|
singleton = (:[])
|
||||||
|
|
||||||
|
|||||||
@@ -49,48 +49,10 @@ errOptIO os e m = case m of
|
|||||||
putIfVerb os k
|
putIfVerb os k
|
||||||
return e
|
return e
|
||||||
|
|
||||||
readFileIf f = catch (readFile f) (\_ -> reportOn f) where
|
|
||||||
reportOn f = do
|
|
||||||
putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string")
|
|
||||||
return ""
|
|
||||||
|
|
||||||
readFileIfStrict f = catch (BS.readFile f) (\_ -> reportOn f) where
|
|
||||||
reportOn f = do
|
|
||||||
putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string")
|
|
||||||
return BS.empty
|
|
||||||
|
|
||||||
type FileName = String
|
type FileName = String
|
||||||
type InitPath = String
|
type InitPath = String
|
||||||
type FullPath = String
|
type FullPath = String
|
||||||
|
|
||||||
getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
|
|
||||||
getFilePath ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file
|
|
||||||
|
|
||||||
getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath)
|
|
||||||
getFilePathMsg msg paths file = get paths where
|
|
||||||
get [] = putStrFlush msg >> return Nothing
|
|
||||||
get (p:ps) = do
|
|
||||||
let pfile = p </> file
|
|
||||||
exist <- doesFileExist pfile
|
|
||||||
if not exist
|
|
||||||
then get ps
|
|
||||||
else do pfile <- canonicalizePath pfile
|
|
||||||
return (Just pfile)
|
|
||||||
|
|
||||||
readFileIfPath :: [FilePath] -> String -> IOE (FilePath,BS.ByteString)
|
|
||||||
readFileIfPath paths file = do
|
|
||||||
mpfile <- ioeIO $ getFilePath paths file
|
|
||||||
case mpfile of
|
|
||||||
Just pfile -> do
|
|
||||||
s <- ioeIO $ BS.readFile pfile
|
|
||||||
return (dropFileName pfile,s)
|
|
||||||
_ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.")
|
|
||||||
|
|
||||||
doesFileExistPath :: [FilePath] -> String -> IOE Bool
|
|
||||||
doesFileExistPath paths file = do
|
|
||||||
mpfile <- ioeIO $ getFilePathMsg "" paths file
|
|
||||||
return $ maybe False (const True) mpfile
|
|
||||||
|
|
||||||
gfLibraryPath = "GF_LIB_PATH"
|
gfLibraryPath = "GF_LIB_PATH"
|
||||||
gfGrammarPathVar = "GF_GRAMMAR_PATH"
|
gfGrammarPathVar = "GF_GRAMMAR_PATH"
|
||||||
|
|
||||||
@@ -143,10 +105,6 @@ splitInModuleSearchPath s = case break isPathSep s of
|
|||||||
|
|
||||||
--
|
--
|
||||||
|
|
||||||
getLineWell :: IO String -> IO String
|
|
||||||
getLineWell ios =
|
|
||||||
catch getLine (\e -> if (isEOFError e) then ios else ioError e)
|
|
||||||
|
|
||||||
putStrFlush :: String -> IO ()
|
putStrFlush :: String -> IO ()
|
||||||
putStrFlush s = putStr s >> hFlush stdout
|
putStrFlush s = putStr s >> hFlush stdout
|
||||||
|
|
||||||
@@ -223,29 +181,3 @@ putPointE v opts msg act = do
|
|||||||
readFileIOE :: FilePath -> IOE BS.ByteString
|
readFileIOE :: FilePath -> IOE BS.ByteString
|
||||||
readFileIOE f = ioe $ catch (BS.readFile f >>= return . return)
|
readFileIOE f = ioe $ catch (BS.readFile f >>= return . return)
|
||||||
(\e -> return (Bad (show e)))
|
(\e -> return (Bad (show e)))
|
||||||
|
|
||||||
-- | like readFileIOE but look also in the GF library if file not found
|
|
||||||
--
|
|
||||||
-- intended semantics: if file is not found, try @\$GF_LIB_PATH\/file@
|
|
||||||
-- (even if file is an absolute path, but this should always fail)
|
|
||||||
-- it returns not only contents of the file, but also the path used
|
|
||||||
readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, BS.ByteString)
|
|
||||||
readFileLibraryIOE ini f = ioe $ do
|
|
||||||
lp <- getLibraryPath
|
|
||||||
tryRead ini $ \_ ->
|
|
||||||
tryRead lp $ \e ->
|
|
||||||
return (Bad (show e))
|
|
||||||
where
|
|
||||||
tryRead path onError =
|
|
||||||
catch (BS.readFile fpath >>= \s -> return (return (fpath,s)))
|
|
||||||
onError
|
|
||||||
where
|
|
||||||
fpath = path </> f
|
|
||||||
|
|
||||||
-- | example
|
|
||||||
koeIOE :: IO ()
|
|
||||||
koeIOE = useIOE () $ do
|
|
||||||
s <- ioeIO $ getLine
|
|
||||||
s2 <- ioeErr $ mapM (!? 2) $ words s
|
|
||||||
ioeIO $ putStrLn s2
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user