diff --git a/src/GF.hs b/src/GF.hs index 1d2651767..50afeb8e9 100644 --- a/src/GF.hs +++ b/src/GF.hs @@ -35,6 +35,7 @@ import GF.Text.UTF8 import GF.Today (today,version,libdir) import GF.System.Arch import System (getArgs,system,getEnv) +import System.FilePath import Control.Monad (foldM,liftM) import Data.List (nub) @@ -106,7 +107,7 @@ main = do mkConcretes os es doGF (removeOption fromExamples os) fs -- preprocessing gfwl - else if (length fs == 1 && fileSuffix (head fs) == "gfwl") + else if (length fs == 1 && takeExtensions (head fs) == ".gfwl") then do fs' <- mkWordlist (head fs) doGF os fs' diff --git a/src/GF/API.hs b/src/GF/API.hs index 7474d3c75..b1deeddfc 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -79,6 +79,7 @@ import Data.Char (toLower) import Data.Maybe (fromMaybe) import Control.Monad (liftM) import System (system) +import System.FilePath type GFGrammar = StateGrammar type GFCat = CFCat @@ -155,7 +156,7 @@ string2GFCat = string2CFCat optFile2grammar :: Options -> FilePath -> IOE GFGrammar optFile2grammar os f - | fileSuffix f == "gfcm" = ioeIO $ liftM firstStateGrammar $ EA.file2grammar f + | takeExtensions f == ".gfcm" = ioeIO $ liftM firstStateGrammar $ EA.file2grammar f | otherwise = do ((_,_,gr,_),_) <- compileModule os emptyShellState f ioeErr $ grammar2stateGrammar os gr diff --git a/src/GF/API/IOGrammar.hs b/src/GF/API/IOGrammar.hs index 335757cf4..bd7fc5648 100644 --- a/src/GF/API/IOGrammar.hs +++ b/src/GF/API/IOGrammar.hs @@ -35,6 +35,7 @@ import GF.System.Arch import qualified Transfer.InterpreterAPI as T import Control.Monad (liftM) +import System.FilePath -- | a heuristic way of renaming constants is used string2absTerm :: String -> String -> Term @@ -58,14 +59,14 @@ shellStateFromFiles :: Options -> ShellState -> FilePath -> IOE ShellState shellStateFromFiles opts st file = do ign <- ioeIO $ getNoparseFromFile opts file let top = identC $ justModuleName file - sh <- case fileSuffix file of - "trc" -> do + sh <- case takeExtensions file of + ".trc" -> do env <- ioeIO $ T.loadFile file return $ addTransfer (top,env) st - "gfcm" -> do + ".gfcm" -> do cenv <- compileOne opts (compileEnvShSt st []) file ioeErr $ updateShellState opts ign Nothing st cenv - s | elem s ["cf","ebnf"] -> do + s | elem s [".cf",".ebnf"] -> do let osb = addOptions (options []) opts grts <- compileModule osb st file ioeErr $ updateShellState opts ign Nothing st grts diff --git a/src/GF/Command/Importing.hs b/src/GF/Command/Importing.hs index 31c4983dc..b223e3e5c 100644 --- a/src/GF/Command/Importing.hs +++ b/src/GF/Command/Importing.hs @@ -9,19 +9,20 @@ import GF.Infra.Option import GF.Data.ErrM import Data.List (nubBy) +import System.FilePath -- import a grammar in an environment where it extends an existing grammar importGrammar :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar importGrammar mgr0 opts files = - case fileSuffix (last files) of - s | elem s ["gf","gfo"] -> do + case takeExtensions (last files) of + s | elem s [".gf",".gfo"] -> do res <- appIOE $ compileToGFCC opts files case res of Ok gfcc2 -> do let gfcc3 = unionGFCC (gfcc mgr0) gfcc2 return $ MultiGrammar gfcc3 Bad msg -> do print msg return mgr0 - "gfcc" -> do + ".gfcc" -> do gfcc2 <- mapM file2gfcc files >>= return . foldl1 unionGFCC let gfcc3 = unionGFCC (gfcc mgr0) gfcc2 return $ MultiGrammar gfcc3 \ No newline at end of file diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs index 856544152..58fc91269 100644 --- a/src/GF/Compile/Compile.hs +++ b/src/GF/Compile/Compile.hs @@ -58,6 +58,7 @@ import GF.System.Arch import Control.Monad import System.Directory +import System.FilePath -- | environment variable for grammar search path gfGrammarPathVar = "GF_GRAMMAR_PATH" @@ -83,20 +84,20 @@ compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv compileModule opts st0 file | oElem showOld opts || - elem suff ["cf","ebnf","gfm"] = do + elem suff [".cf",".ebnf",".gfm"] = do let putp = putPointE opts let putpp = putPointEsil opts let path = [] ---- grammar1 <- case suff of - "cf" -> putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file - "ebnf" -> putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file - "gfm" -> putp ("- parsing" +++ suff +++ file) $ getSourceGrammar opts file - _ -> putp ("- parsing old gf" +++ file) $ getOldGrammar opts file + ".cf" -> putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file + ".ebnf" -> putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file + ".gfm" -> putp ("- parsing" +++ suff +++ file) $ getSourceGrammar opts file + _ -> putp ("- parsing old gf" +++ file) $ getOldGrammar opts file let mods = modules grammar1 let env = compileEnvShSt st0 [] foldM (comp putpp path) env mods where - suff = fileSuffix file + suff = takeExtensions file comp putpp path env sm0 = do (k',sm,eenv') <- makeSourceModule opts (fst env) sm0 cm <- putpp " generating code... " $ generateModuleCode opts path sm @@ -108,18 +109,18 @@ compileModule opts1 st0 file = do let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList let opts = addOptions opts1 opts0 - let fpath = justInitPath file + let fpath = dropFileName file ps0 <- ioeIO $ pathListOpts opts fpath let ps1 = if (useFileOpt && not useLineOpt) - then (ps0 ++ map (prefixPathName fpath) ps0) + then (ps0 ++ map (combine fpath) ps0) else ps0 ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1 let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ())) ioeIOIf $ putStrLn $ "module search path:" +++ show ps ---- let st = st0 --- if useFileOpt then emptyShellState else st0 let rfs = [(m,t) | (m,(_,t)) <- readFiles st] - let file' = if useFileOpt then justFileName file else file -- to find file itself + let file' = if useFileOpt then takeFileName file else file -- to find file itself files <- getAllFiles opts ps rfs file' ioeIOIf $ putStrLn $ "files to read:" +++ show files ---- let names = map justModuleName files @@ -138,13 +139,13 @@ compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv compileEnvShSt st fs = ((0,sgr,cgr,eenv),fts) where cgr = MGrammar [m | m@(i,_) <- modules (canModules st), notInc i] sgr = MGrammar [m | m@(i,_) <- modules (srcModules st), notIns i] - notInc i = notElem (prt i) $ map fileBody fs - notIns i = notElem (prt i) $ map fileBody fs + notInc i = notElem (prt i) $ map dropExtension fs + notIns i = notElem (prt i) $ map dropExtension fs fts = readFiles st eenv = evalEnv st pathListOpts :: Options -> FileName -> IO [InitPath] -pathListOpts opts file = return $ maybe [file] pFilePaths $ getOptVal opts pathList +pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList reverseModules (MGrammar ms) = MGrammar $ reverse ms @@ -181,20 +182,20 @@ compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do | oElem beSilent opts = putpp v act | otherwise = ioeIO (putStrFlush m) >> act - let gf = fileSuffix file - let path = justInitPath file - let name = fileBody file + let gf = takeExtensions file + let path = dropFileName file + let name = dropExtension file let mos = modules srcgr case gf of -- for multilingual canonical gf, just read the file and update environment - "gfcm" -> do + ".gfcm" -> do cgr <- putp ("+ reading" +++ file) $ getCanonGrammar file ft <- getReadTimes file extendCompileEnvCanon env cgr eenv ft -- for canonical gf, read the file and update environment, also source env - "gfc" -> do + ".gfc" -> do cm <- putp ("+ reading" +++ file) $ getCanonModule file let cancgr = updateMGrammar (MGrammar [cm]) cancgr0 sm <- ioeErr $ CG.canon2sourceModule $ unoptimizeCanonMod cancgr $ unSubelimModule cm @@ -202,7 +203,7 @@ compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do extendCompileEnv env (sm, cm) eenv ft -- for compiled resource, parse and organize, then update environment - "gfr" -> do + ".gfr" -> do sm0 <- putp ("| reading" +++ file) $ getSourceModule opts file let sm1 = unsubexpModule sm0 sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1 @@ -219,7 +220,7 @@ compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do --- hack fix to a bug in ReadFiles with reused concrete - let modu = unsuffixFile file + let modu = dropExtension file b1 <- ioeIO $ doesFileExist file b2 <- ioeIO $ doesFileExist $ gfrFile modu if not b1 @@ -308,7 +309,7 @@ generateModuleCode opts path minfo@(name,info) = do --- then ioeIO $ putStrLn $ prGrammar2gfcc minfo --- else return () - let pname = prefixPathName path (prt name) + let pname = path prt name minfo0 <- ioeErr $ redModInfo minfo let oopts = addOptions opts (iOpts (flagsModule minfo)) optims = maybe "all_subs" id $ getOptVal oopts useOptimizer @@ -389,15 +390,15 @@ getGFEFiles opts1 file = useIOE [] $ do let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList let opts = addOptions opts1 opts0 - let fpath = justInitPath file + let fpath = dropFileName file ps0 <- ioeIO $ pathListOpts opts fpath let ps1 = if (useFileOpt && not useLineOpt) - then (map (prefixPathName fpath) ps0) + then (map (combine fpath) ps0) else ps0 ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1 - let file' = if useFileOpt then justFileName file else file -- to find file itself + let file' = if useFileOpt then takeFileName file else file -- to find file itself files <- getAllFiles opts ps [] file' - efiles <- ioeIO $ filterM doesFileExist [suffixFile "gfe" (unsuffixFile f) | f <- files] + efiles <- ioeIO $ filterM doesFileExist [replaceExtension f "gfe" | f <- files] es <- ioeIO $ mapM (uncurry selectLater) [(f, init f) | f <- efiles] -- init gfe == gf return $ filter ((=='e') . last) es diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs index f0cf5d197..294edbf9a 100644 --- a/src/GF/Compile/GetGrammar.hs +++ b/src/GF/Compile/GetGrammar.hs @@ -46,6 +46,7 @@ import Data.List (nub) import qualified Data.ByteString.Char8 as BS import Control.Monad (foldM) import System (system) +import System.FilePath getSourceModule :: Options -> FilePath -> IOE SourceModule getSourceModule opts file0 = do @@ -79,7 +80,7 @@ getOldGrammar :: Options -> FilePath -> IOE SourceGrammar getOldGrammar opts file = do defs <- parseOldGrammarFiles file let g = A.OldGr A.NoIncl defs - let name = justFileName file + let name = takeFileName file ioeErr $ transOldGrammar opts name g parseOldGrammarFiles :: FilePath -> IOE [A.TopDef] diff --git a/src/GF/Compile/MkConcrete.hs b/src/GF/Compile/MkConcrete.hs index 5413d1b79..0124acca6 100644 --- a/src/GF/Compile/MkConcrete.hs +++ b/src/GF/Compile/MkConcrete.hs @@ -36,6 +36,7 @@ import GF.System.Arch import GF.UseGrammar.Treebank import System.Directory +import System.FilePath import Data.Char import Control.Monad import Data.List @@ -111,7 +112,7 @@ mkConcrete :: Parser -> Morpho -> FilePath -> IO () mkConcrete parser morpho file = do src <- appIOE (getSourceModule noOptions file) >>= err error return let (src',msgs) = mkModule parser morpho src - let out = suffixFile "gf" $ justModuleName file + let out = addExtension (justModuleName file) "gf" writeFile out $ "-- File generated by GF from " ++ file appendFile out "\n" appendFile out (prModule src') diff --git a/src/GF/Compile/Wordlist.hs b/src/GF/Compile/Wordlist.hs index d581ed683..3fbc066bd 100644 --- a/src/GF/Compile/Wordlist.hs +++ b/src/GF/Compile/Wordlist.hs @@ -18,6 +18,7 @@ import GF.Data.Operations import GF.Infra.UseIO import Data.List import Data.Char +import System.FilePath -- read File.gfwl, write File.gf (abstract) and a set of concretes -- return the names of the concretes @@ -25,7 +26,7 @@ import Data.Char mkWordlist :: FilePath -> IO [FilePath] mkWordlist file = do s <- readFileIf file - let abs = fileBody file + let abs = dropExtension file let (cnchs,wlist) = pWordlist abs $ filter notComment $ lines s let (gr,grs) = mkGrammars abs cnchs wlist let cncfs = [cnc ++ ".gf" | (cnc,_) <- cnchs] diff --git a/src/GF/Devel/Compile.hs b/src/GF/Devel/Compile.hs index 149e49c5d..538aa1309 100644 --- a/src/GF/Devel/Compile.hs +++ b/src/GF/Devel/Compile.hs @@ -29,6 +29,7 @@ import GF.Devel.Arch import Control.Monad import System.Directory +import System.FilePath batchCompile :: Options -> [FilePath] -> IOE SourceGrammar batchCompile opts files = do @@ -64,24 +65,24 @@ compileModule opts1 env file = do let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList let opts = addOptions opts1 opts0 - let fpath = justInitPath file + let fpath = dropFileName file ps0 <- ioeIO $ pathListOpts opts fpath let ps1 = if (useFileOpt && not useLineOpt) - then (ps0 ++ map (prefixPathName fpath) ps0) + then (ps0 ++ map (combine fpath) ps0) else ps0 ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1 let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ())) ioeIOIf $ putStrLn $ "module search path:" +++ show ps ---- let sgr = snd env let rfs = [] ---- files already in memory and their read times - let file' = if useFileOpt then justFileName file else file -- to find file itself + let file' = if useFileOpt then takeFileName file else file -- to find file itself files <- getAllFiles opts ps rfs file' ioeIOIf $ putStrLn $ "files to read:" +++ show files ---- let names = map justModuleName files ioeIOIf $ putStrLn $ "modules to include:" +++ show names ---- let sgr2 = MGrammar [m | m@(i,_) <- modules sgr, - notElem (prt i) $ map fileBody names] + notElem (prt i) $ map dropExtension names] foldM (compileOne opts) (0,sgr2) files @@ -95,16 +96,16 @@ compileOne opts env@(_,srcgr) file = do | oElem beSilent opts = putpp v act | otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act - let gf = fileSuffix file - let path = justInitPath file - let name = fileBody file + let gf = takeExtensions file + let path = dropFileName file + let name = dropExtension file let mos = modules srcgr case gf of -- for compiled gf, read the file and update environment -- also undo common subexp optimization, to enable normal computations - "gfo" -> do + ".gfo" -> do sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file let sm1 = unsubexpModule sm0 sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1 @@ -113,7 +114,7 @@ compileOne opts env@(_,srcgr) file = do -- for gf source, do full compilation and generate code _ -> do - let modu = unsuffixFile file + let modu = dropExtension file b1 <- ioeIO $ doesFileExist file if not b1 then compileOne opts env $ gfoFile $ modu @@ -174,7 +175,7 @@ compileSourceModule opts env@(k,gr) mo@(i,mi) = do generateModuleCode :: Options -> InitPath -> SourceModule -> IOE SourceModule generateModuleCode opts path minfo@(name,info) = do - let pname = prefixPathName path (prt name) + let pname = path prt name let minfo0 = minfo let minfo1 = subexpModule minfo0 let minfo2 = minfo1 @@ -191,7 +192,7 @@ generateModuleCode opts path minfo@(name,info) = do -- auxiliaries pathListOpts :: Options -> FileName -> IO [InitPath] -pathListOpts opts file = return $ maybe [file] pFilePaths $ getOptVal opts pathList +pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList reverseModules (MGrammar ms) = MGrammar $ reverse ms diff --git a/src/GF/Devel/Compile/Compile.hs b/src/GF/Devel/Compile/Compile.hs index e0de193c1..65c0530f1 100644 --- a/src/GF/Devel/Compile/Compile.hs +++ b/src/GF/Devel/Compile/Compile.hs @@ -61,24 +61,24 @@ compileModule opts1 env file = do let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList let opts = addOptions opts1 opts0 - let fpath = justInitPath file + let fpath = dropFileName file ps0 <- ioeIO $ pathListOpts opts fpath let ps1 = if (useFileOpt && not useLineOpt) - then (ps0 ++ map (prefixPathName fpath) ps0) + then (ps0 ++ map (combine fpath) ps0) else ps0 ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1 let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ())) ioeIOIf $ putStrLn $ "module search path:" +++ show ps ---- let sgr = snd env let rfs = [] ---- files already in memory and their read times - let file' = if useFileOpt then justFileName file else file -- find file itself + let file' = if useFileOpt then takeFileName file else file -- find file itself files <- getAllFiles opts ps rfs file' ioeIOIf $ putStrLn $ "files to read:" +++ show files ---- let names = map justModuleName files ioeIOIf $ putStrLn $ "modules to include:" +++ show names ---- let sgr2 = sgr ----MGrammar [m | m@(i,_) <- modules sgr, - ---- notElem (prt i) $ map fileBody names] + ---- notElem (prt i) $ map dropExtension names] let env0 = (0,sgr2) (e,mm) <- foldIOE (compileOne opts) env0 files maybe (return ()) putStrLnE mm @@ -95,9 +95,9 @@ compileOne opts env@(_,srcgr) file = do | oElem beSilent opts = putpp v act | otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act - let gf = fileSuffix file - let path = justInitPath file - let name = fileBody file + let gf = takeExtensions file + let path = dropFileName file + let name = dropExtension file let mos = gfmodules srcgr case gf of @@ -105,7 +105,7 @@ compileOne opts env@(_,srcgr) file = do -- for compiled gf, read the file and update environment -- also undo common subexp optimization, to enable normal computations - "gfn" -> do + ".gfn" -> do sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file let sm1 = unsubexpModule sm0 sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule srcgr sm1 @@ -114,7 +114,7 @@ compileOne opts env@(_,srcgr) file = do -- for gf source, do full compilation and generate code _ -> do - let modu = unsuffixFile file + let modu = dropExtension file b1 <- ioeIO $ doesFileExist file if not b1 then compileOne opts env $ gfoFile $ modu @@ -178,7 +178,7 @@ compileSourceModule opts env@(k,gr) mo@(i,mi) = do generateModuleCode :: Options -> InitPath -> SourceModule -> IOE () generateModuleCode opts path minfo@(name,info) = do - let pname = prefixPathName path (prt name) + let pname = combine path (prt name) let minfo0 = minfo let minfo1 = subexpModule minfo0 let minfo2 = minfo1 @@ -194,7 +194,7 @@ generateModuleCode opts path minfo@(name,info) = do -- auxiliaries pathListOpts :: Options -> FileName -> IO [InitPath] -pathListOpts opts file = return $ maybe [file] pFilePaths $ getOptVal opts pathList +pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList ----reverseModules (MGrammar ms) = MGrammar $ reverse ms diff --git a/src/GF/Devel/Compile/GFC.hs b/src/GF/Devel/Compile/GFC.hs index 31be084a1..f60ec9380 100644 --- a/src/GF/Devel/Compile/GFC.hs +++ b/src/GF/Devel/Compile/GFC.hs @@ -32,7 +32,7 @@ mainGFC xx = do mapM_ (alsoPrint opts target gc) printOptions -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc - _ | all ((=="gfcc") . fileSuffix) fs -> do + _ | all ((==".gfcc") . takeExtensions) fs -> do gfccs <- mapM file2gfcc fs let gfcc = foldl1 unionGFCC gfccs let abs = printCId $ absname gfcc diff --git a/src/GF/Devel/GFC.hs b/src/GF/Devel/GFC.hs index 87af00b8b..27e0e3ae2 100644 --- a/src/GF/Devel/GFC.hs +++ b/src/GF/Devel/GFC.hs @@ -12,6 +12,8 @@ import GF.Infra.Option import GF.GFCC.API import GF.Data.ErrM +import System.FilePath + mainGFC :: [String] -> IO () mainGFC xx = do let (opts,fs) = getOptions "-" xx @@ -24,7 +26,7 @@ mainGFC xx = do mapM_ (alsoPrint opts gfcc) printOptions -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc - _ | all ((=="gfcc") . fileSuffix) fs -> do + _ | all ((==".gfcc") . takeExtensions) fs -> do gfccs <- mapM file2gfcc fs let gfcc = foldl1 unionGFCC gfccs let gfccFile = targetNameGFCC opts (absname gfcc) diff --git a/src/GF/Devel/Infra/ReadFiles.hs b/src/GF/Devel/Infra/ReadFiles.hs index ad1a1ac5e..dd8cbe5a9 100644 --- a/src/GF/Devel/Infra/ReadFiles.hs +++ b/src/GF/Devel/Infra/ReadFiles.hs @@ -58,7 +58,7 @@ getAllFiles opts ps env file = do let paths = [(f,p) | ((f,_),p) <- ds] let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]] if oElem fromSource opts - then return [gfFile (prefixPathName p f) | (p,f) <- pds1] + then return [gfFile (p f) | (p,f) <- pds1] else do @@ -84,7 +84,7 @@ selectFormat :: Options -> ModEnv -> (InitPath,ModName) -> IO (ModName,(InitPath,(CompStatus,Maybe ModTime))) selectFormat opts env (p,f) = do - let pf = prefixPathName p f + let pf = p f let mtenv = lookup f env -- Nothing if f is not in env let rtenv = lookup (resModName f) env let fromComp = oElem isCompiled opts -- i -gfo @@ -177,20 +177,20 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where -- construct list of paths to read paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]] - mkName f p st = mk $ prefixPathName p f where + mkName f p st = mk (p f) where mk = case st of CSComp -> gfFile CSRead -> gfoFile CSRes -> gfoFile ---- gfr isGFO :: FilePath -> Bool -isGFO = (== "gfn") . fileSuffix +isGFO = (== ".gfn") . takeExtensions gfoFile :: FilePath -> FilePath -gfoFile = suffixFile "gfn" +gfoFile f = addExtension f "gfn" gfFile :: FilePath -> FilePath -gfFile = suffixFile "gf" +gfFile f = addExtension f "gf" resModName :: ModName -> ModName resModName = ('#':) @@ -200,10 +200,10 @@ resModName = ('#':) getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)] getImports ps = get [] where get ds file0 = do - let name = justModuleName file0 ---- fileBody file0 + let name = dropExtension file0 ---- dropExtension file0 (p,s) <- tryRead name let ((typ,mname),imps) = importsOfFile s - let namebody = justFileName name + let namebody = takeFileName name ioeErr $ testErr (mname == namebody) $ "module name" +++ mname +++ "differs from file name" +++ namebody case imps of diff --git a/src/GF/Devel/Options.hs b/src/GF/Devel/Options.hs index 14b598225..9a4087096 100644 --- a/src/GF/Devel/Options.hs +++ b/src/GF/Devel/Options.hs @@ -178,7 +178,7 @@ moduleOptDescr = ] where addLibDir x o = return $ o { optLibraryPath = x:optLibraryPath o } - setLibPath x o = return $ o { optLibraryPath = splitSearchPath x } + setLibPath x o = return $ o { optLibraryPath = splitInModuleSearchPath x } preproc x o = return $ o { optPreprocessors = optPreprocessors o ++ [x] } optimize x b o = return $ o { optOptimizations = (if b then (x:) else delete x) (optOptimizations o) } parser x o = return $ o { optBuildParser = x } diff --git a/src/GF/Devel/ReadFiles.hs b/src/GF/Devel/ReadFiles.hs index f4968d575..36b932ed0 100644 --- a/src/GF/Devel/ReadFiles.hs +++ b/src/GF/Devel/ReadFiles.hs @@ -30,16 +30,17 @@ import GF.Infra.Option import GF.Data.Operations import GF.Devel.UseIO -import System import Data.Char import Control.Monad import Data.List -import System.Directory import qualified Data.ByteString.Char8 as BS import GF.Source.AbsGF hiding (FileName) import GF.Source.LexGF import GF.Source.ParGF +import System +import System.Directory +import System.FilePath type ModName = String type ModEnv = [(ModName,ModTime)] @@ -63,7 +64,7 @@ getAllFiles opts ps env file = do let paths = [(f,p) | ((f,_),p) <- ds] let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]] if oElem fromSource opts - then return [gfFile (prefixPathName p f) | (p,f) <- pds1] + then return [gfFile (p f) | (p,f) <- pds1] else do @@ -89,7 +90,7 @@ selectFormat :: Options -> ModEnv -> (InitPath,ModName) -> IO (ModName,(InitPath,(CompStatus,Maybe ModTime))) selectFormat opts env (p,f) = do - let pf = prefixPathName p f + let pf = p f let mtenv = lookup f env -- Nothing if f is not in env let rtenv = lookup (resModName f) env let fromComp = oElem isCompiled opts -- i -gfo @@ -182,20 +183,20 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where -- construct list of paths to read paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]] - mkName f p st = mk $ prefixPathName p f where + mkName f p st = mk (p f) where mk = case st of CSComp -> gfFile CSRead -> gfoFile CSRes -> gfoFile ---- gfr isGFO :: FilePath -> Bool -isGFO = (== "gfo") . fileSuffix +isGFO = (== ".gfo") . takeExtensions gfoFile :: FilePath -> FilePath -gfoFile = suffixFile "gfo" +gfoFile f = addExtension f "gfo" gfFile :: FilePath -> FilePath -gfFile = suffixFile "gf" +gfFile f = addExtension f "gf" resModName :: ModName -> ModName resModName = ('#':) @@ -205,10 +206,10 @@ resModName = ('#':) getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)] getImports ps = get [] where get ds file0 = do - let name = justModuleName file0 ---- fileBody file0 + let name = justModuleName file0 ---- dropExtension file0 (p,s) <- tryRead name ((typ,mname),imps) <- ioeErr (importsOfFile s) - let namebody = justFileName name + let namebody = takeFileName name ioeErr $ testErr (mname == namebody) $ "module name" +++ mname +++ "differs from file name" +++ namebody case imps of diff --git a/src/GF/Devel/UseIO.hs b/src/GF/Devel/UseIO.hs index e7b6e490e..39c451be4 100644 --- a/src/GF/Devel/UseIO.hs +++ b/src/GF/Devel/UseIO.hs @@ -21,6 +21,7 @@ import GF.Infra.Option import GF.Today (libdir) import System.Directory +import System.FilePath import System.IO import System.IO.Error import System.Environment @@ -95,12 +96,6 @@ type FileName = String type InitPath = String type FullPath = String -isPathSep :: Char -> Bool -isPathSep c = c == ':' || c == ';' - -isSep :: Char -> Bool -isSep c = c == '/' || c == '\\' - getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) getFilePath ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file @@ -108,7 +103,7 @@ 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 = prefixPathName p file + let pfile = p file exist <- doesFileExist pfile if exist then return (Just pfile) else get ps --- catch (readFileStrict pfile >> return (Just pfile)) (\_ -> get ps) @@ -119,7 +114,7 @@ readFileIfPath paths file = do case mpfile of Just pfile -> do s <- ioeIO $ BS.readFile pfile - return (justInitPath pfile,s) + return (dropFileName pfile,s) _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.") doesFileExistPath :: [FilePath] -> String -> IOE Bool @@ -145,67 +140,37 @@ extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath] extendPathEnv lib var ps = do b <- getLibraryPath -- e.g. GF_LIB_PATH s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH - let fs = pFilePaths s - let ss = ps ++ fs - liftM concat $ mapM allSubdirs $ ss ++ [b ++ "/" ++ s | s <- ss ++ ["prelude"]] - -pFilePaths :: String -> [FilePath] -pFilePaths s = case break isPathSep s of - (f,_:cs) -> f : pFilePaths cs - (f,_) -> [f] - -getFilePaths :: String -> IO [FilePath] -getFilePaths s = do - let ps = pFilePaths s - liftM concat $ mapM allSubdirs ps + let ss = ps ++ splitSearchPath s + liftM concat $ mapM allSubdirs $ ss ++ [b s | s <- ss ++ ["prelude"]] + where + allSubdirs :: FilePath -> IO [FilePath] + allSubdirs [] = return [[]] + allSubdirs p = case last p of + '*' -> do + let path = init p + fs <- getSubdirs path + return [path f | f <- fs] + _ -> return [p] getSubdirs :: FilePath -> IO [FilePath] -getSubdirs p = do - fs <- catch (getDirectoryContents p) (const $ return []) - fps <- mapM getPermissions (map (prefixPathName p) fs) - let ds = [f | (f,p) <- zip fs fps, searchable p, not (take 1 f==".")] - return ds - -allSubdirs :: FilePath -> IO [FilePath] -allSubdirs [] = return [[]] -allSubdirs p = case last p of - '*' -> do - fs <- getSubdirs (init p) - return [prefixPathName (init p) f | f <- fs] - _ -> return [p] - -prefixPathName :: String -> FilePath -> FilePath -prefixPathName p f = case f of - c:_ | isSep c -> f -- do not prefix [Unix style] absolute paths - _ -> case p of - "" -> f - _ -> p ++ "/" ++ f -- note: / actually works on windows - -justInitPath :: FilePath -> FilePath -justInitPath = reverse . drop 1 . dropWhile (not . isSep) . reverse - -nameAndSuffix :: FilePath -> (String,String) -nameAndSuffix file = case span (/='.') (reverse file) of - (_,[]) -> (file,[]) - (xet,deman) -> if any isSep xet - then (file,[]) -- cover cases like "foo.bar/baz" - else (reverse $ drop 1 deman,reverse xet) - -unsuffixFile, fileBody :: FilePath -> String -unsuffixFile = fst . nameAndSuffix -fileBody = unsuffixFile - -fileSuffix :: FilePath -> String -fileSuffix = snd . nameAndSuffix - -justFileName :: FilePath -> String -justFileName = reverse . takeWhile (not . isSep) . reverse - -suffixFile :: String -> FilePath -> FilePath -suffixFile suff file = file ++ "." ++ suff +getSubdirs dir = do + fs <- catch (getDirectoryContents dir) (const $ return []) + foldM (\fs f -> do let fpath = dir f + p <- getPermissions fpath + if searchable p && not (take 1 f==".") + then return (fpath:fs) + else return fs ) [] fs justModuleName :: FilePath -> String -justModuleName = fileBody . justFileName +justModuleName = dropExtension . takeFileName + +splitInModuleSearchPath :: String -> [FilePath] +splitInModuleSearchPath s = case break isPathSep s of + (f,_:cs) -> f : splitInModuleSearchPath cs + (f,_) -> [f] + where + isPathSep :: Char -> Bool + isPathSep c = c == ':' || c == ';' -- @@ -318,39 +283,25 @@ gfLibraryPath = "GF_LIB_PATH" -- ((do {s <- readFile f; return (return s)}) ) 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." + (\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 --- --- FIXME: unix-specific, \/ is \\ on Windows readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, BS.ByteString) -readFileLibraryIOE ini f = - ioe $ catch (do {s <- BS.readFile initPath; return (return (initPath,s))}) - (\_ -> tryLibrary ini f) where - tryLibrary :: String -> FilePath -> IO (Err (FilePath, BS.ByteString)) - tryLibrary ini f = - catch (do { - lp <- getLibPath; - s <- BS.readFile (lp ++ f); - return (return (lp ++ f, s)) - }) (\_ -> return (Bad (reportOn f))) - initPath = addInitFilePath ini f - getLibPath :: IO String - getLibPath = do { - lp <- catch (getEnv gfLibraryPath) (const (return libdir)) ; - return (if isSep (last lp) then lp else lp ++ ['/']); - } - reportOn f = "File " ++ f ++ " not found." - libPath ini f = f - addInitFilePath ini file = case file of - c:_ | isSep c -> file -- absolute path name - _ -> ini ++ file -- relative path name - +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 () diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs index 4707015fd..ce33ec23f 100644 --- a/src/GF/Infra/ReadFiles.hs +++ b/src/GF/Infra/ReadFiles.hs @@ -35,6 +35,7 @@ import Data.Char import Control.Monad import Data.List import System.Directory +import System.FilePath type ModName = String type ModEnv = [(ModName,ModTime)] @@ -58,7 +59,7 @@ getAllFiles opts ps env file = do let paths = [(f,p) | ((f,_),p) <- ds] let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]] if oElem fromSource opts - then return [gfFile (prefixPathName p f) | (p,f) <- pds1] + then return [gfFile (p f) | (p,f) <- pds1] else do @@ -84,7 +85,7 @@ selectFormat :: Options -> ModEnv -> (InitPath,ModName) -> IO (ModName,(InitPath,(CompStatus,Maybe ModTime))) selectFormat opts env (p,f) = do - let pf = prefixPathName p f + let pf = p f let mtenv = lookup f env -- Nothing if f is not in env let rtenv = lookup (resModName f) env let fromComp = oElem isCompiled opts -- i -gfc @@ -184,23 +185,23 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where -- construct list of paths to read paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]] - mkName f p st = mk $ prefixPathName p f where + mkName f p st = mk (p f) where mk = case st of CSComp -> gfFile CSRead -> gfcFile CSRes -> gfrFile isGFC :: FilePath -> Bool -isGFC = (== "gfc") . fileSuffix +isGFC = (== ".gfc") . takeExtensions gfcFile :: FilePath -> FilePath -gfcFile = suffixFile "gfc" +gfcFile f = addExtension f "gfc" gfrFile :: FilePath -> FilePath -gfrFile = suffixFile "gfr" +gfrFile f = addExtension f "gfr" gfFile :: FilePath -> FilePath -gfFile = suffixFile "gf" +gfFile f = addExtension f "gf" resModName :: ModName -> ModName resModName = ('#':) @@ -210,10 +211,10 @@ resModName = ('#':) getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)] getImports ps = get [] where get ds file0 = do - let name = justModuleName file0 ---- fileBody file0 + let name = dropExtension file0 ---- dropExtension file0 (p,s) <- tryRead name let ((typ,mname),imps) = importsOfFile s - let namebody = justFileName name + let namebody = takeFileName name ioeErr $ testErr (mname == namebody) $ "module name" +++ mname +++ "differs from file name" +++ namebody case imps of diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index 2680c0327..01331dd08 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -99,20 +99,15 @@ type FileName = String type InitPath = String type FullPath = String -isPathSep :: Char -> Bool -isPathSep c = c == ':' || c == ';' - -isSep :: Char -> Bool -isSep c = c == '/' || c == '\\' - getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) -getFilePath ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file +getFilePath ps file = do + 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 = prefixPathName p file + let pfile = p file exist <- doesFileExist pfile if exist then return (Just pfile) else get ps --- catch (readFileStrict pfile >> return (Just pfile)) (\_ -> get ps) @@ -123,7 +118,7 @@ readFileIfPath paths file = do case mpfile of Just pfile -> do s <- ioeIO $ readFileStrict pfile - return (justInitPath pfile,s) + return (dropFileName pfile,s) _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.") doesFileExistPath :: [FilePath] -> String -> IOE Bool @@ -149,67 +144,37 @@ extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath] extendPathEnv lib var ps = do b <- getLibraryPath -- e.g. GF_LIB_PATH s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH - let fs = pFilePaths s - let ss = ps ++ fs - liftM concat $ mapM allSubdirs $ ss ++ [b ++ "/" ++ s | s <- ss ++ ["prelude"]] - -pFilePaths :: String -> [FilePath] -pFilePaths s = case break isPathSep s of - (f,_:cs) -> f : pFilePaths cs - (f,_) -> [f] - -getFilePaths :: String -> IO [FilePath] -getFilePaths s = do - let ps = pFilePaths s - liftM concat $ mapM allSubdirs ps + let ss = ps ++ splitSearchPath s + liftM concat $ mapM allSubdirs $ ss ++ [b s | s <- ss ++ ["prelude"]] + where + allSubdirs :: FilePath -> IO [FilePath] + allSubdirs [] = return [[]] + allSubdirs p = case last p of + '*' -> do + let path = init p + fs <- getSubdirs path + return [path f | f <- fs] + _ -> return [p] getSubdirs :: FilePath -> IO [FilePath] -getSubdirs p = do - fs <- catch (getDirectoryContents p) (const $ return []) - fps <- mapM getPermissions (map (prefixPathName p) fs) - let ds = [f | (f,p) <- zip fs fps, searchable p, not (take 1 f==".")] - return ds - -allSubdirs :: FilePath -> IO [FilePath] -allSubdirs [] = return [[]] -allSubdirs p = case last p of - '*' -> do - fs <- getSubdirs (init p) - return [prefixPathName (init p) f | f <- fs] - _ -> return [p] - -prefixPathName :: String -> FilePath -> FilePath -prefixPathName p f = case f of - c:_ | isSep c -> f -- do not prefix [Unix style] absolute paths - _ -> case p of - "" -> f - _ -> p ++ "/" ++ f -- note: / actually works on windows - -justInitPath :: FilePath -> FilePath -justInitPath = reverse . drop 1 . dropWhile (not . isSep) . reverse - -nameAndSuffix :: FilePath -> (String,String) -nameAndSuffix file = case span (/='.') (reverse file) of - (_,[]) -> (file,[]) - (xet,deman) -> if any isSep xet - then (file,[]) -- cover cases like "foo.bar/baz" - else (reverse $ drop 1 deman,reverse xet) - -unsuffixFile, fileBody :: FilePath -> String -unsuffixFile = fst . nameAndSuffix -fileBody = unsuffixFile - -fileSuffix :: FilePath -> String -fileSuffix = snd . nameAndSuffix - -justFileName :: FilePath -> String -justFileName = reverse . takeWhile (not . isSep) . reverse - -suffixFile :: String -> FilePath -> FilePath -suffixFile suff file = file ++ "." ++ suff +getSubdirs dir = do + fs <- catch (getDirectoryContents dir) (const $ return []) + foldM (\fs f -> do let fpath = dir f + p <- getPermissions fpath + if searchable p && not (take 1 f==".") + then return (fpath:fs) + else return fs ) [] fs justModuleName :: FilePath -> String -justModuleName = fileBody . justFileName +justModuleName = dropExtension . takeFileName + +splitInModuleSearchPath :: String -> [FilePath] +splitInModuleSearchPath s = case break isPathSep s of + (f,_:cs) -> f : splitInModuleSearchPath cs + (f,_) -> [f] + where + isPathSep :: Char -> Bool + isPathSep c = c == ':' || c == ';' -- @@ -331,39 +296,25 @@ gfLibraryPath = "GF_LIB_PATH" -- ((do {s <- readFile f; return (return s)}) ) readFileIOE :: FilePath -> IOE (String) readFileIOE f = ioe $ catch (readFileStrict f >>= return . return) - (\_ -> return (Bad (reportOn f))) where - reportOn f = "File " ++ f ++ " not found." + (\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 --- --- FIXME: unix-specific, \/ is \\ on Windows readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String) -readFileLibraryIOE ini f = - ioe $ catch ((do {s <- readFileStrict initPath; return (return (initPath,s))})) - (\_ -> tryLibrary ini f) where - tryLibrary :: String -> FilePath -> IO (Err (FilePath, String)) - tryLibrary ini f = - catch (do { - lp <- getLibPath; - s <- readFileStrict (lp ++ f); - return (return (lp ++ f, s)) - }) (\_ -> return (Bad (reportOn f))) - initPath = addInitFilePath ini f - getLibPath :: IO String - getLibPath = do { - lp <- catch (getEnv gfLibraryPath) (const (return libdir)) ; - return (if isSep (last lp) then lp else lp ++ ['/']); - } - reportOn f = "File " ++ f ++ " not found." - libPath ini f = f - addInitFilePath ini file = case file of - c:_ | isSep c -> file -- absolute path name - _ -> ini ++ file -- relative path name - +readFileLibraryIOE ini f = ioe $ do + lp <- getLibraryPath + tryRead ini $ \_ -> + tryRead lp $ \e -> + return (Bad (show e)) + where + tryRead path onError = + catch (readFileStrict fpath >>= \s -> return (return (fpath,s))) + onError + where + fpath = path f -- | example koeIOE :: IO () diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index b884534bd..1d723bc62 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -70,6 +70,7 @@ import Data.Maybe (fromMaybe) import GF.System.Signal (runInterruptibly) import System.Exit (exitFailure) +import System.FilePath ---- import qualified GrammarToGramlet as Gr ---- import qualified GrammarToCanonXML2 as Canon @@ -192,7 +193,7 @@ execLine put (c@(co, os), arg, cs) (outps,st) = do execC :: CommandOpt -> ShellIO execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case comm of - CImport file | fileSuffix file == "gfwl" -> do + CImport file | takeExtensions file == ".gfwl" -> do fs <- mkWordlist file foldM (\x y -> execC (CImport y, opts) x) sa fs diff --git a/src/GF/UseGrammar/Treebank.hs b/src/GF/UseGrammar/Treebank.hs index d353efc8a..841a9c6dc 100644 --- a/src/GF/UseGrammar/Treebank.hs +++ b/src/GF/UseGrammar/Treebank.hs @@ -50,6 +50,7 @@ import qualified Data.Map as M import qualified Data.Set as S import qualified Data.List as L import Control.Monad (liftM) +import System.FilePath -- Generate a treebank with a multilingual grammar. AR 8/2/2006 -- (c) Aarne Ranta 2006 under GNU GPL @@ -68,14 +69,14 @@ readUniTreebanks file = do then multi2uniTreebank $ getTreebank $ lines s else let tb = getUniTreebank $ lines s - in [(zIdent (unsuffixFile file),tb)] + in [(zIdent (dropExtension file),tb)] readMultiTreebank :: FilePath -> IO MultiTreebank readMultiTreebank file = do s <- readFileIf file return $ if isMultiTreebank s then getTreebank $ lines s - else uni2multiTreebank (zIdent (unsuffixFile file)) $ getUniTreebank $ lines s + else uni2multiTreebank (zIdent (dropExtension file)) $ getUniTreebank $ lines s isMultiTreebank :: String -> Bool isMultiTreebank s = take 10 s == ""