From 8eeb72e09dbe0afe432f83e5552a6aa8a00f3928 Mon Sep 17 00:00:00 2001 From: ijones Date: Sun, 9 Oct 2005 09:44:54 +0000 Subject: [PATCH] make --with-haddock actually work ** did this ever work before? ** cleaned up some comments ** made rawSystemVerbose more robust. Check for file existing, check for permissions. Before it was just failing silently. --- Distribution/Program.hs | 63 ++++++++++++++++++++++++++++-------- Distribution/Simple.hs | 10 +++--- Distribution/Simple/Utils.hs | 17 ++++++---- 3 files changed, 66 insertions(+), 24 deletions(-) diff --git a/Distribution/Program.hs b/Distribution/Program.hs index da65d0b51ce..dd14e4508a4 100644 --- a/Distribution/Program.hs +++ b/Distribution/Program.hs @@ -9,6 +9,8 @@ module Distribution.Program( Program(..) , userSpecifyPath , userSpecifyArgs , lookupProgram + , rawSystemProgram + -- Programs , ghcProgram , ghcPkgProgram , nhcProgram @@ -25,7 +27,10 @@ module Distribution.Program( Program(..) ) where import Data.FiniteMap +import Control.Monad(when) +import System.Exit (ExitCode) import Distribution.Compat.Directory(findExecutable) +import Distribution.Simple.Utils (die, rawSystemVerbose) -- |Represents a program which cabal may call. data Program @@ -48,15 +53,23 @@ data ProgramLocation = EmptyLocation data ProgramConfiguration = ProgramConfiguration (FiniteMap String Program) +-- Read & Show instances are based on listToFM + instance Show ProgramConfiguration where show (ProgramConfiguration s) = show $ fmToList s instance Read ProgramConfiguration where - readsPrec p s = [(ProgramConfiguration $ listToFM $ s', r) | (s', r) <- readsPrec p s ] + readsPrec p s = [(ProgramConfiguration $ listToFM $ s', r) + | (s', r) <- readsPrec p s ] + +-- |The default list of programs and their arguments. These programs +-- are typically used internally to Cabal. defaultProgramConfiguration :: ProgramConfiguration defaultProgramConfiguration = progListToFM - [ ghcProgram + [ haddockProgram ] +-- haddock is currently the only one that really works. +{- [ ghcProgram , ghcPkgProgram , nhcProgram , hugsProgram @@ -69,7 +82,7 @@ defaultProgramConfiguration = progListToFM , ldProgram , cppProgram , pfesetupProgram - ] + ]-} -- |The flag for giving a path to this program. eg --with-alex=\/usr\/bin\/alex withProgramFlag :: Program -> String @@ -132,13 +145,12 @@ pfesetupProgram = simpleProgram "pfesetup" -- * helpers -- ------------------------------------------------------------ --- |Looks up a program in the given configuration. If the user --- provides a location, then we use that location in the returned --- program. If no location is given then we check in the --- configuration for a location. If there's none in the --- configuration, then we use IO to look on the system. Do we want a --- way to specify NOT to find it on the system (populate --- programLocation). +-- |Looks up a program in the given configuration. If there's no +-- location information in the configuration, then we use IO to look +-- on the system in PATH for the program. If the program is not in +-- the configuration at all, we return Nothing. FIX: should we build +-- a simpleProgram in that case? Do we want a way to specify NOT to +-- find it on the system (populate programLocation). lookupProgram :: String -- simple name of program -> ProgramConfiguration @@ -155,8 +167,10 @@ lookupProgram name conf = a -> return a return $ Just p{programLocation=newLoc} --- |User-specify this path. If it's not a known program, add it. -userSpecifyPath :: String -- ^Program name +-- |User-specify this path. Basically override any path information +-- for this program in the configuration. If it's not a known +-- program, add it. +userSpecifyPath :: String -- ^Program name -> FilePath -- ^user-specified path to filename -> ProgramConfiguration -> ProgramConfiguration @@ -166,7 +180,9 @@ userSpecifyPath name path conf'@(ProgramConfiguration conf) Nothing -> updateProgram (Just $ Program name name [] (UserSpecified path)) conf' --- |User-specify this path. If it's not a known program, add it. +-- |User-specify the arguments for this program. Basically override +-- any args information for this program in the configuration. If it's +-- not a known program, add it. userSpecifyArgs :: String -- ^Program name -> String -- ^user-specified args -> ProgramConfiguration @@ -176,11 +192,32 @@ userSpecifyArgs name args conf'@(ProgramConfiguration conf) Just p -> updateProgram (Just p{programArgs=(words args)}) conf' Nothing -> updateProgram (Just $ Program name name (words args) EmptyLocation) conf' +-- |Update this program's entry in the configuration. No changes if +-- you pass in Nothing. updateProgram :: Maybe Program -> ProgramConfiguration -> ProgramConfiguration updateProgram (Just p@Program{programName=n}) (ProgramConfiguration conf) = ProgramConfiguration $ addToFM conf n p updateProgram Nothing conf = conf +-- |Runs the given program. +rawSystemProgram :: Int -- ^Verbosity + -> Program -- ^The program to run + -> [String] -- ^Any /extra/ arguments to add + -> IO ExitCode +rawSystemProgram verbose (Program { programLocation=(UserSpecified p) + , programArgs=args + }) + + extraArgs = rawSystemVerbose verbose p (extraArgs ++ args) +rawSystemProgram verbose (Program { programLocation=(FoundOnSystem p) + , programArgs=args + }) + + extraArgs = rawSystemVerbose verbose p (extraArgs ++ args) +rawSystemProgram _ (Program { programLocation=EmptyLocation + , programName=n})_ + = die ("Error: Could not find location for program: " ++ n) + -- ------------------------------------------------------------ -- * Internal helpers -- ------------------------------------------------------------ diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs index cb8dcafa344..39e6e342aca 100644 --- a/Distribution/Simple.hs +++ b/Distribution/Simple.hs @@ -67,7 +67,8 @@ module Distribution.Simple ( import Distribution.Compiler import Distribution.Package --must not specify imports, since we're exporting moule. import Distribution.PackageDescription -import Distribution.Program(lookupProgram, Program(..), haddockProgram) +import Distribution.Program(lookupProgram, Program(..), + haddockProgram, rawSystemProgram) import Distribution.PreProcess (knownSuffixHandlers, ppSuffixes, ppCpp', ppUnlit, removePreprocessedPackage, preprocessSources, PPSuffixHandler) @@ -80,8 +81,9 @@ import Distribution.Simple.Register ( register, unregister, regScriptLocation, unregScriptLocation ) -import Distribution.Simple.Configure(LocalBuildInfo(..), getPersistBuildConfig, findProgram, - configure, writePersistBuildConfig, localBuildInfoFile) +import Distribution.Simple.Configure(LocalBuildInfo(..), getPersistBuildConfig, + findProgram, configure, writePersistBuildConfig, + localBuildInfoFile) import Distribution.Simple.Install(install) import Distribution.Simple.Utils (die, currentDir, rawSystemVerbose, defaultPackageDesc, defaultHookedPackageDesc, @@ -434,7 +436,7 @@ haddock pkg_descr lbi verbose pps = setupMessage "Running Haddock for" pkg_descr let outFiles = map (joinFileName tmpDir) (map ((flip changeFileExt) "hs") inFiles) - code <- rawSystemVerbose verbose (programBinName confHaddock) + code <- rawSystemProgram verbose confHaddock (["-h", "-o", targetDir, "-t", showPkg, diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs index a9a7a7a2f10..71fd1ece9f9 100644 --- a/Distribution/Simple/Utils.hs +++ b/Distribution/Simple/Utils.hs @@ -95,7 +95,7 @@ import Distribution.Compat.FilePath (splitFileName, splitFileExt, joinFileName, joinFileExt, pathSeparator) import System.Directory (getDirectoryContents, getCurrentDirectory, - doesFileExist, removeFile) + doesFileExist, removeFile, getPermissions, executable) import Distribution.Compat.Directory (copyFile,findExecutable,createDirectoryIfMissing) @@ -129,16 +129,19 @@ rawSystemPath verbose prog args = do r <- findExecutable prog case r of Nothing -> die ("Cannot find: " ++ prog) - Just path -> do - when (verbose > 0) $ - putStrLn (path ++ concatMap (' ':) args) - rawSystem path args + Just path -> rawSystemVerbose verbose path args -rawSystemVerbose :: Int -> String -> [String] -> IO ExitCode +rawSystemVerbose :: Int -> FilePath -> [String] -> IO ExitCode rawSystemVerbose verbose prog args = do when (verbose > 0) $ putStrLn (prog ++ concatMap (' ':) args) - rawSystem prog args + e <- doesFileExist prog + if e + then do perms <- getPermissions prog + if (executable perms) + then rawSystem prog args + else die ("Error: file is not executable: " ++ show prog) + else die ("Error: file does not exist: " ++ show prog) maybeExit :: IO ExitCode -> IO () maybeExit cmd = do