Search for module by name and do not require language folder

This commit is contained in:
John J. Camilleri
2018-08-04 18:40:40 +02:00
parent 7f5fae2031
commit 8600112264
2 changed files with 20 additions and 15 deletions

31
Make.hs
View File

@@ -4,10 +4,10 @@ import System.IO (hPutStrLn,stderr)
import System.IO.Error (catchIOError)
import System.Exit (ExitCode(..),die)
import System.Environment (getArgs,lookupEnv)
import System.Process (rawSystem,readProcess)
import System.FilePath ((</>),(<.>),takeFileName,addExtension,dropExtension)
import System.Directory (createDirectoryIfMissing,copyFile,getDirectoryContents,removeDirectoryRecursive,doesFileExist)
import Control.Monad (unless,when)
import System.Process (rawSystem)
import System.FilePath ((</>),takeFileName,addExtension,dropExtension)
import System.Directory (createDirectoryIfMissing,copyFile,getDirectoryContents,removeDirectoryRecursive,findFile)
import Control.Monad (when)
main :: IO ()
main = do
@@ -159,16 +159,14 @@ rglCommands =
, RGLCommand "modules" False $ \modes args bi -> do
let modules = getOptModules args
flip mapM_ modules $ \m -> do
-- TODO search for modules so that folder name is not needed
-- TODO determine dependants, e.g. include ExtraEngAbs when specifying ExtraEng
let mfull = sourceDir </> m
ex <- doesFileExist mfull
if not ex
then die $ "Cannot find module: " ++ m
else flip mapM_ modes $ \mode -> do
let dst = getRGLBuildDir bi mode
putStrLn $ "Building [" ++ m ++ "] " ++ dst
run_gfc bi ["-s", "--gfo-dir="++dst, mfull]
mex <- findModule m
case mex of
Nothing -> die $ "Cannot find module: " ++ m
Just mfull -> flip mapM_ modes $ \mode -> do
let dst = getRGLBuildDir bi mode
putStrLn $ "Building [" ++ m ++ "] " ++ dst
run_gfc bi ["-s", "--gfo-dir="++dst, mfull]
-- , RGLCommand "pgf" False $ \modes args bi ->
-- parallel_ [
@@ -211,6 +209,13 @@ rglCommands =
Present -> intersect langsPresent
_ -> id
-- | Search all language dirs for module name
findModule :: String -> IO (Maybe FilePath)
findModule file = do
let langdirs = map langDir langs
let searchdirs = map ((</>) sourceDir) langdirs
findFile searchdirs file
-- | Get commands from args
-- Fails on command error
getCommands :: [String] -> [RGLCommand]

View File

@@ -64,12 +64,12 @@ clean
`compat`,
<!-- `pgf`, -->
`parse`,
or an explicit module name (e.g. `english/ExtraEng.gf`).
or an explicit module name (e.g. `ExtraEng.gf`).
- `MODE` is one of:
`present`,
`alltenses`
(default is both).
- `FILES` is a space separated list of module names (e.g. `english/ExtraEng.gf german/DictGer.gf`)
- `FILES` is a space separated list of module names (e.g. `ExtraEng.gf DictGer.gf`)
- You can _override_ the default language list with `--langs=...`
- You can _add_ languages to the default list with `--langs=+...`
- You can _remove_ languages from the default list with `langs=-...`