From cd1942a8454d569363b201f2345953e648ec9b53 Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Thu, 19 Jul 2018 12:36:39 +0200 Subject: [PATCH] WebSetup: fail silently when example grammars don't build Also used installed RGL not built --- Setup.hs | 4 +++- WebSetup.hs | 14 ++++++++------ 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/Setup.hs b/Setup.hs index 5a2113ce6..c0ad6ebbf 100644 --- a/Setup.hs +++ b/Setup.hs @@ -9,6 +9,7 @@ import Data.List(isPrefixOf,intersect) import System.Process(readProcess) import System.FilePath((),(<.>)) import System.Directory(createDirectoryIfMissing,copyFile,getDirectoryContents) +import System.Exit(die) import WebSetup @@ -380,7 +381,8 @@ run_gfc bi args = do let args' = numJobs (bf bi)++["-batch","-gf-lib-path="++rgl_src_dir] ++ filter (not . null) args gf = default_gf (lbi bi) - execute gf args' + ok <- execute gf args' + if ok then return () else die "Stopping" -- | Get path to locally-built gf default_gf :: LocalBuildInfo -> FilePath diff --git a/WebSetup.hs b/WebSetup.hs index e6c776bb9..02123f5bd 100644 --- a/WebSetup.hs +++ b/WebSetup.hs @@ -6,7 +6,6 @@ import System.Process(rawSystem) import System.Exit(ExitCode(..)) import Distribution.Simple.Setup(BuildFlags(..),Flag(..),CopyFlags(..),CopyDest(..),copyDest) import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..),datadir,buildDir,absoluteInstallDirs) -import Distribution.Simple.Utils(die) -- deprecated as of Cabal >= 2 import Distribution.PackageDescription(PackageDescription(..)) {- @@ -68,9 +67,11 @@ buildWeb gf (flags,pkg,lbi) = do where tmp_dir = gfo_dirsubdir dir = contrib_dirsubdir + dest = NoCopyDest + gf_lib_path = datadir (absoluteInstallDirs pkg lbi dest) "lib" args = numJobs flags++["-make","-s"] -- ,"-optimize-pgf" ++["--gfo-dir="++tmp_dir, - "--gf-lib-path="++buildDir lbi "rgl", + "--gf-lib-path="++gf_lib_path, "--name="++dropExtension pgf, "--output-dir="++gfo_dir] ++[dirfile|file<-src] @@ -111,15 +112,16 @@ setupWeb dest (pkg,lbi) = do do createDirectoryIfMissing True logo_dir copyFile ("doc""Logos"gf_logo) (logo_dirgf_logo) --- | Run an arbitrary system command -execute :: String -> [String] -> IO () +-- | Run an arbitrary system command, returning False on failure +execute :: String -> [String] -> IO Bool execute command args = do let cmdline = command ++ " " ++ unwords (map showArg args) e <- rawSystem command args case e of - ExitSuccess -> return () + ExitSuccess -> return True ExitFailure i -> do putStrLn $ "Ran: " ++ cmdline - die $ command++" exited with exit code: " ++ show i + putStrLn $ command++" exited with exit code: " ++ show i + return False where showArg arg = if ' ' `elem` arg then "'" ++ arg ++ "'" else arg