From 4a8346086d967ef75513de1220267bbc5b753bbe Mon Sep 17 00:00:00 2001 From: krasimir Date: Thu, 17 Apr 2008 12:56:46 +0000 Subject: [PATCH] ByteString.readFile should be used instead of readFileStrict. This fixes the problem with the open files --- src/GF/Devel/GetGrammar.hs | 1 + src/GF/Devel/ReadFiles.hs | 8 +++++--- src/GF/Devel/UseIO.hs | 33 +++++++++++++++------------------ src/GF/Source/LexGF.hs | 18 ++++++++++-------- 4 files changed, 31 insertions(+), 29 deletions(-) diff --git a/src/GF/Devel/GetGrammar.hs b/src/GF/Devel/GetGrammar.hs index 4b54f789d..e8136b1dd 100644 --- a/src/GF/Devel/GetGrammar.hs +++ b/src/GF/Devel/GetGrammar.hs @@ -34,6 +34,7 @@ import GF.Devel.ReadFiles ---- import Data.Char (toUpper) import Data.List (nub) +import qualified Data.ByteString.Char8 as BS import Control.Monad (foldM) import System (system) diff --git a/src/GF/Devel/ReadFiles.hs b/src/GF/Devel/ReadFiles.hs index a99bc01b2..0a1d69d2a 100644 --- a/src/GF/Devel/ReadFiles.hs +++ b/src/GF/Devel/ReadFiles.hs @@ -35,6 +35,8 @@ import Data.Char import Control.Monad import Data.List import System.Directory +import qualified Data.ByteString.Char8 as BS + type ModName = String type ModEnv = [(ModName,ModTime)] @@ -202,7 +204,7 @@ getImports ps = get [] where get ds file0 = do let name = justModuleName file0 ---- fileBody file0 (p,s) <- tryRead name - let ((typ,mname),imps) = importsOfFile s + let ((typ,mname),imps) = importsOfFile (BS.unpack s) let namebody = justFileName name ioeErr $ testErr (mname == namebody) $ "module name" +++ mname +++ "differs from file name" +++ namebody @@ -317,14 +319,14 @@ lexs s = x:xs where getOptionsFromFile :: FilePath -> IO Options getOptionsFromFile file = do s <- readFileIfStrict file - let ls = filter (isPrefixOf "--#") $ lines s + let ls = filter (isPrefixOf "--#") $ lines (BS.unpack s) return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls -- | check if old GF file isOldFile :: FilePath -> IO Bool isOldFile f = do s <- readFileIfStrict f - let s' = unComm s + let s' = unComm (BS.unpack s) return $ not (null s') && old (head (words s')) where old = flip elem $ words diff --git a/src/GF/Devel/UseIO.hs b/src/GF/Devel/UseIO.hs index db276ae75..e7b6e490e 100644 --- a/src/GF/Devel/UseIO.hs +++ b/src/GF/Devel/UseIO.hs @@ -26,6 +26,7 @@ import System.IO.Error import System.Environment import System.CPUTime import Control.Monad +import qualified Data.ByteString.Char8 as BS #ifdef mingw32_HOST_OS import System.Win32.DLL @@ -80,20 +81,16 @@ putPoint' f opts msg act = do ve $ putCPU return a -readFileStrict :: String -> IO String -readFileStrict f = do - s <- readFile f - return $ seq (length s) () - return s - -readFileIf = readFileIfs readFile -readFileIfStrict = readFileIfs readFileStrict - -readFileIfs rf f = catch (rf f) (\_ -> reportOn f) where +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 InitPath = String type FullPath = String @@ -116,12 +113,12 @@ getFilePathMsg msg paths file = get paths where if exist then return (Just pfile) else get ps --- catch (readFileStrict pfile >> return (Just pfile)) (\_ -> get ps) -readFileIfPath :: [FilePath] -> String -> IOE (FilePath,String) +readFileIfPath :: [FilePath] -> String -> IOE (FilePath,BS.ByteString) readFileIfPath paths file = do mpfile <- ioeIO $ getFilePath paths file case mpfile of Just pfile -> do - s <- ioeIO $ readFileStrict pfile + s <- ioeIO $ BS.readFile pfile return (justInitPath pfile,s) _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.") @@ -319,8 +316,8 @@ putPointEVerb opts = putPointE (addOption beVerbose opts) gfLibraryPath = "GF_LIB_PATH" -- ((do {s <- readFile f; return (return s)}) ) -readFileIOE :: FilePath -> IOE (String) -readFileIOE f = ioe $ catch (readFileStrict f >>= return . return) +readFileIOE :: FilePath -> IOE BS.ByteString +readFileIOE f = ioe $ catch (BS.readFile f >>= return . return) (\_ -> return (Bad (reportOn f))) where reportOn f = "File " ++ f ++ " not found." @@ -331,15 +328,15 @@ readFileIOE f = ioe $ catch (readFileStrict f >>= return . return) -- it returns not only contents of the file, but also the path used -- -- FIXME: unix-specific, \/ is \\ on Windows -readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String) +readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, BS.ByteString) readFileLibraryIOE ini f = - ioe $ catch ((do {s <- readFileStrict initPath; return (return (initPath,s))})) + ioe $ catch (do {s <- BS.readFile initPath; return (return (initPath,s))}) (\_ -> tryLibrary ini f) where - tryLibrary :: String -> FilePath -> IO (Err (FilePath, String)) + tryLibrary :: String -> FilePath -> IO (Err (FilePath, BS.ByteString)) tryLibrary ini f = catch (do { lp <- getLibPath; - s <- readFileStrict (lp ++ f); + s <- BS.readFile (lp ++ f); return (return (lp ++ f, s)) }) (\_ -> return (Bad (reportOn f))) initPath = addInitFilePath ini f diff --git a/src/GF/Source/LexGF.hs b/src/GF/Source/LexGF.hs index 6bdd4ab9f..89067b6b6 100644 --- a/src/GF/Source/LexGF.hs +++ b/src/GF/Source/LexGF.hs @@ -4,6 +4,7 @@ module GF.Source.LexGF where +import qualified Data.ByteString.Char8 as BS #if __GLASGOW_HASKELL__ >= 603 #include "ghcconfig.h" @@ -119,24 +120,25 @@ alexMove (Pn a l c) _ = Pn (a+1) l (c+1) type AlexInput = (Posn, -- current position, Char, -- previous char - String) -- current input string + BS.ByteString) -- current input string -tokens :: String -> [Token] +tokens :: BS.ByteString -> [Token] tokens str = go (alexStartPos, '\n', str) where - go :: (Posn, Char, String) -> [Token] + go :: AlexInput -> [Token] go inp@(pos, _, str) = case alexScan inp 0 of AlexEOF -> [] AlexError (pos, _, _) -> [Err pos] AlexSkip inp' len -> go inp' - AlexToken inp' len act -> act pos (take len str) : (go inp') + AlexToken inp' len act -> act pos (BS.unpack (BS.take len str)) : (go inp') alexGetChar :: AlexInput -> Maybe (Char,AlexInput) -alexGetChar (p, c, []) = Nothing -alexGetChar (p, _, (c:s)) = - let p' = alexMove p c - in p' `seq` Just (c, (p', c, s)) +alexGetChar (p,_,cs) | BS.null cs = Nothing + | otherwise = let c = BS.head cs + cs' = BS.tail cs + p' = alexMove p c + in p' `seq` cs' `seq` Just (c, (p', c, cs')) alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (p, c, s) = c