summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2008-04-22 11:39:46 +0000
committerkrasimir <krasimir@chalmers.se>2008-04-22 11:39:46 +0000
commitfc111c1a7910ab4a2a1bf40c0473bbaacadedd61 (patch)
tree6f9c2bed83320272ebe41f314fd930f2a13ce3d9 /src
parent7a6adbf35932efeed283f762b300b6f5a3b21d8a (diff)
use the standard System.FilePath module instead of our own broken file path manipulation functions
Diffstat (limited to 'src')
-rw-r--r--src/GF.hs3
-rw-r--r--src/GF/API.hs3
-rw-r--r--src/GF/API/IOGrammar.hs9
-rw-r--r--src/GF/Command/Importing.hs7
-rw-r--r--src/GF/Compile/Compile.hs49
-rw-r--r--src/GF/Compile/GetGrammar.hs3
-rw-r--r--src/GF/Compile/MkConcrete.hs3
-rw-r--r--src/GF/Compile/Wordlist.hs3
-rw-r--r--src/GF/Devel/Compile.hs23
-rw-r--r--src/GF/Devel/Compile/Compile.hs22
-rw-r--r--src/GF/Devel/Compile/GFC.hs2
-rw-r--r--src/GF/Devel/GFC.hs4
-rw-r--r--src/GF/Devel/Infra/ReadFiles.hs16
-rw-r--r--src/GF/Devel/Options.hs2
-rw-r--r--src/GF/Devel/ReadFiles.hs21
-rw-r--r--src/GF/Devel/UseIO.hs133
-rw-r--r--src/GF/Infra/ReadFiles.hs19
-rw-r--r--src/GF/Infra/UseIO.hs135
-rw-r--r--src/GF/Shell.hs3
-rw-r--r--src/GF/UseGrammar/Treebank.hs5
20 files changed, 191 insertions, 274 deletions
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 == "<treebank>"