mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
use the standard System.FilePath module instead of our own broken file path manipulation functions
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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')
|
||||
|
||||
@@ -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]
|
||||
|
||||
Reference in New Issue
Block a user