GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

use the standard System.FilePath module instead of our own broken file path manipulation functions

Browse Source
This commit is contained in:
krasimir
2008-04-22 11:39:46 +00:00
parent caa6082b82
commit e16215940e
20 changed files with 191 additions and 274 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/GF.hs
View File

@@ -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'

3
src/GF/API.hs
View File

@@ -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

9
src/GF/API/IOGrammar.hs
View File

@@ -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

7
src/GF/Command/Importing.hs
View File

@@ -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

49
src/GF/Compile/Compile.hs
View File

@@ -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

3
src/GF/Compile/GetGrammar.hs
View File

@@ -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]

3
src/GF/Compile/MkConcrete.hs
View File

@@ -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')

3
src/GF/Compile/Wordlist.hs
View File

@@ -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]

23
src/GF/Devel/Compile.hs
View File

@@ -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

22
src/GF/Devel/Compile/Compile.hs
View File

@@ -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

2
src/GF/Devel/Compile/GFC.hs
View File

@@ -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

4
src/GF/Devel/GFC.hs
View File

@@ -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)

16
src/GF/Devel/Infra/ReadFiles.hs
View File

@@ -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

2
src/GF/Devel/Options.hs
View File

@@ -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 }

21
src/GF/Devel/ReadFiles.hs
View File

@@ -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

133
src/GF/Devel/UseIO.hs
View File

@@ -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 ()

19
src/GF/Infra/ReadFiles.hs
View File

@@ -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

135
src/GF/Infra/UseIO.hs
View File

@@ -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 ()

3
src/GF/Shell.hs
View File

@@ -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

5
src/GF/UseGrammar/Treebank.hs
View File

@@ -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>"