msyds/gf-rgl
1
0
Fork 0
forked from GitHub/gf-rgl
Code Pull Requests Activity

Re-add argument checking in Make.hs

Browse Source
This commit is contained in:
John J. Camilleri
2018-08-04 18:44:16 +02:00
parent 8600112264
commit 59672ef8ac
1 changed files with 17 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
Make.hs
View File

@@ -1,4 +1,4 @@
import Data.List (find,intersect,isPrefixOf,isSuffixOf) import Data.List (find,intersect,isPrefixOf,isSuffixOf,(\\))
import Data.Maybe (fromJust,isJust,catMaybes) import Data.Maybe (fromJust,isJust,catMaybes)
import System.IO (hPutStrLn,stderr) import System.IO (hPutStrLn,stderr)
import System.IO.Error (catchIOError) import System.IO.Error (catchIOError)
@@ -7,7 +7,7 @@ import System.Environment (getArgs,lookupEnv)
import System.Process (rawSystem) import System.Process (rawSystem)
import System.FilePath ((</>),takeFileName,addExtension,dropExtension) import System.FilePath ((</>),takeFileName,addExtension,dropExtension)
import System.Directory (createDirectoryIfMissing,copyFile,getDirectoryContents,removeDirectoryRecursive,findFile) import System.Directory (createDirectoryIfMissing,copyFile,getDirectoryContents,removeDirectoryRecursive,findFile)
import Control.Monad (when) import Control.Monad (when,unless)
main :: IO () main :: IO ()
main = do main = do
@@ -25,6 +25,7 @@ main = do
-- | Build grammars into dist -- | Build grammars into dist
buildRGL :: [String] -> IO () buildRGL :: [String] -> IO ()
buildRGL args = do buildRGL args = do
checkArgs args
let cmds = getCommands args let cmds = getCommands args
let modes = getOptMode args let modes = getOptMode args
info <- mkInfo info <- mkInfo
@@ -216,8 +217,21 @@ findModule file = do
let searchdirs = map ((</>) sourceDir) langdirs let searchdirs = map ((</>) sourceDir) langdirs
findFile searchdirs file findFile searchdirs file
-- | Check arguments are valid, failing on error
checkArgs :: [String] -> IO ()
checkArgs args = do
let args'' = args \\ (getOptModules args)
let args' = flip filter args'' (\arg -> not
( arg `elem` (map cmdName rglCommands)
|| arg `elem` all_modes
|| lang_flag `isPrefixOf` arg
|| gf_flag `isPrefixOf` arg
|| destination_flag `isPrefixOf` arg
))
unless (null args') $ die $ "Unrecognised argument: " ++ unwords args'
return ()
-- | Get commands from args -- | Get commands from args
-- Fails on command error
getCommands :: [String] -> [RGLCommand] getCommands :: [String] -> [RGLCommand]
getCommands args = getCommands args =
let let
@@ -233,19 +247,6 @@ getCommands args =
then [cmd | cmd <- rglCommands, cmdIsDef cmd] then [cmd | cmd <- rglCommands, cmdIsDef cmd]
else cmds0 else cmds0
-- -- | Check arguments are valid
-- checkArgs :: [String] -> IO ()
-- checkArgs args = do
-- let args' = flip filter args (\arg -> not
-- ( arg `elem` (map cmdName rglCommands)
-- || arg `elem` all_modes
-- || lang_flag `isPrefixOf` arg
-- || gf_flag `isPrefixOf` arg
-- || destination_flag `isPrefixOf` arg
-- ))
-- unless (null args') $ die $ "Unrecognised flags: " ++ unwords args'
-- return ()
-- | Get mode from args (may be missing) -- | Get mode from args (may be missing)
getOptMode :: [String] -> [Mode] getOptMode :: [String] -> [Mode]
getOptMode args = getOptMode args =
@@ -277,7 +278,6 @@ getOptLangs defaultLangs args =
else ls else ls
-- | Get module names from arguments -- | Get module names from arguments
-- TODO check if they exist
getOptModules :: [String] -> [FilePath] getOptModules :: [String] -> [FilePath]
getOptModules = filter (isSuffixOf ".gf") getOptModules = filter (isSuffixOf ".gf")