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

Add --verbose/-v switch to Make.hs

Browse Source
This commit is contained in:
John J. Camilleri
2018-08-06 10:29:42 +02:00
parent e44ab11609
commit 70297f6ac2
2 changed files with 19 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
Make.hs
View File

@@ -88,6 +88,7 @@ data Info = Info
{ infoBuildDir :: FilePath -- ^ where to put built RGL modules (fixed) { infoBuildDir :: FilePath -- ^ where to put built RGL modules (fixed)
, infoInstallDir :: Maybe FilePath -- ^ install directory (found dynamically) , infoInstallDir :: Maybe FilePath -- ^ install directory (found dynamically)
, infoGFPath :: FilePath -- ^ path to GF , infoGFPath :: FilePath -- ^ path to GF
, infoVerbose :: Bool
} deriving (Show) } deriving (Show)
-- | Build info object from command line args -- | Build info object from command line args
@@ -104,11 +105,13 @@ mkInfo = do
case catMaybes [mflag,menvar,mbuilt] of case catMaybes [mflag,menvar,mbuilt] of
[] -> Nothing [] -> Nothing
p:_ -> Just p p:_ -> Just p
let verbose = verbose_switch `elem` args || verbose_switch_short `elem` args
return $ Info return $ Info
{ infoBuildDir = "dist" { infoBuildDir = "dist"
, infoInstallDir = inst_dir , infoInstallDir = inst_dir
, infoGFPath = maybe default_gf id (getFlag gf_flag args) , infoGFPath = maybe default_gf id (getFlag gf_flag args)
, infoVerbose = verbose
} }
where where
default_gf = "gf" default_gf = "gf"
@@ -150,7 +153,7 @@ rglCommands =
prelude_dst_dir = infoBuildDir bi </> "prelude" prelude_dst_dir = infoBuildDir bi </> "prelude"
createDirectoryIfMissing True prelude_dst_dir createDirectoryIfMissing True prelude_dst_dir
files <- getDirectoryContents prelude_src_dir files <- getDirectoryContents prelude_src_dir
run_gfc bi (["-s", "--gfo-dir="++prelude_dst_dir] ++ [prelude_src_dir </> file | file <- files, file /= "." && file /= ".."]) run_gfc bi ([if infoVerbose bi then "--verbose" else "--quiet", "--gfo-dir="++prelude_dst_dir] ++ [prelude_src_dir </> file | file <- files, file /= "." && file /= ".."])
, RGLCommand "all" True $ gfcp [l,s,c,t,sc] , RGLCommand "all" True $ gfcp [l,s,c,t,sc]
, RGLCommand "lang" False $ gfcp [l,s] , RGLCommand "lang" False $ gfcp [l,s]
@@ -167,7 +170,7 @@ rglCommands =
Just mfull -> flip mapM_ modes $ \mode -> do Just mfull -> flip mapM_ modes $ \mode -> do
let dst = getRGLBuildDir bi mode let dst = getRGLBuildDir bi mode
putStrLn $ "Building [" ++ m ++ "] " ++ dst putStrLn $ "Building [" ++ m ++ "] " ++ dst
run_gfc bi ["-s", "--gfo-dir="++dst, mfull] run_gfc bi [if infoVerbose bi then "--verbose" else "--quiet", "--gfo-dir="++dst, mfull]
-- , RGLCommand "pgf" False $ \modes args bi -> -- , RGLCommand "pgf" False $ \modes args bi ->
-- parallel_ [ -- parallel_ [
@@ -227,6 +230,7 @@ checkArgs args = do
|| lang_flag `isPrefixOf` arg || lang_flag `isPrefixOf` arg
|| gf_flag `isPrefixOf` arg || gf_flag `isPrefixOf` arg
|| destination_flag `isPrefixOf` arg || destination_flag `isPrefixOf` arg
|| arg `elem` [verbose_switch, verbose_switch_short]
)) ))
unless (null args') $ die $ "Unrecognised argument: " ++ unwords args' unless (null args') $ die $ "Unrecognised argument: " ++ unwords args'
return () return ()
@@ -294,6 +298,13 @@ gf_flag = "--gf="
destination_flag :: String destination_flag :: String
destination_flag = "--dest=" destination_flag = "--dest="
-- | Switch for making verbose
verbose_switch :: String
verbose_switch = "--verbose"
verbose_switch_short :: String
verbose_switch_short = "-v"
-- | Get flag value from list of args -- | Get flag value from list of args
getFlag :: String -> [String] -> Maybe String getFlag :: String -> [String] -> Maybe String
getFlag flag args = fmap (drop (length flag)) $ find (isPrefixOf flag) args getFlag flag args = fmap (drop (length flag)) $ find (isPrefixOf flag) args
@@ -422,7 +433,7 @@ parse l = sourceDir </> "parse" </> ("Parse" ++ langCode l ++ ".gf")
-- | Get unlexer flags for languages -- | Get unlexer flags for languages
unlexer :: String -> [LangInfo] -> String unlexer :: String -> [LangInfo] -> String
unlexer abstr ls = unlexer abstr ls =
"-unlexer=\\\"" ++ unwords "--unlexer=\\\"" ++ unwords
[ abstr ++ langCode lang ++ "=" ++ fromJust unl [ abstr ++ langCode lang ++ "=" ++ fromJust unl
| lang <- ls | lang <- ls
, let unl = langUnlexer lang , let unl = langUnlexer lang
@@ -440,16 +451,16 @@ gfcn bi mode summary files = do
let dir = getRGLBuildDir bi mode let dir = getRGLBuildDir bi mode
preproc = case mode of preproc = case mode of
AllTenses -> "" AllTenses -> ""
Present -> "-preproc=mkPresent" Present -> "--preproc=mkPresent"
createDirectoryIfMissing True dir createDirectoryIfMissing True dir
putStrLn $ "Building [" ++ show mode ++ "] " ++ summary putStrLn $ "Building [" ++ show mode ++ "] " ++ summary
run_gfc bi (["-s", "-no-pmcfg", preproc, "--gfo-dir="++dir] ++ files) run_gfc bi ([if infoVerbose bi then "--verbose" else "--quiet", "--no-pmcfg", preproc, "--gfo-dir="++dir] ++ files)
-- | Runs the gf executable in compile mode with the given arguments -- | Runs the gf executable in compile mode with the given arguments
run_gfc :: Info -> [String] -> IO () run_gfc :: Info -> [String] -> IO ()
run_gfc bi args = do run_gfc bi args = do
let let
args' = ["-batch","-gf-lib-path="++sourceDir] ++ filter (not . null) args args' = ["--batch","--gf-lib-path="++sourceDir] ++ filter (not . null) args
gf = infoGFPath bi gf = infoGFPath bi
execute gf args' execute gf args'

4
README.md
View File

@@ -50,9 +50,9 @@ runghc Make.hs ...
Where `...` is one of: Where `...` is one of:
``` ```
build [CMDS] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] build [CMDS] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] [--verbose|-v]
copy [MODE] [--dest=...] copy [MODE] [--dest=...]
install [CMDS] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] [--dest=...] install [CMDS] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] [--dest=...] [--verbose|-v]
clean clean
``` ```