{-# OPTIONS -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Program -- Copyright : Isaac Jones 2006 -- -- Maintainer : Isaac Jones -- Stability : alpha -- Portability : GHC, Hugs -- -- Explanation: A program is basically a name, a location, and some -- arguments. -- -- One nice thing about using it is that any program that is -- registered with Cabal will get some \"configure\" and \".cabal\" -- helpers like --with-foo-args --foo-path= and extra-foo-args. -- -- There's also good default behavior for trying to find \"foo\" in -- PATH, being able to override its location, etc. -- -- There's also a hook for adding programs in a Setup.lhs script. See -- hookedPrograms in 'Distribution.Simple.UserHooks'. This gives a -- hook user the ability to get the above flags and such so that they -- don't have to write all the PATH logic inside Setup.lhs. module Distribution.Simple.Program ( -- * Program and functions for constructing them Program(..) , simpleProgram , findProgramOnPath , findProgramVersion -- * Configured program and related functions , ConfiguredProgram(..) , programPath , ProgArg , ProgramLocation(..) , rawSystemProgram , rawSystemProgramStdout -- * The collection of unconfigured and configured progams , builtinPrograms -- * The collection of configured programs we can run , ProgramConfiguration , emptyProgramConfiguration , defaultProgramConfiguration , addKnownProgram , lookupKnownProgram , knownPrograms , userSpecifyPath , userMaybeSpecifyPath , userSpecifyArgs , lookupProgram , updateProgram , configureAllKnownPrograms , requireProgram , rawSystemProgramConf , rawSystemProgramStdoutConf -- * Programs that Cabal knows about , ghcProgram , ghcPkgProgram , nhcProgram , hmakeProgram , jhcProgram , hugsProgram , ffihugsProgram , ranlibProgram , arProgram , happyProgram , alexProgram , hsc2hsProgram , c2hsProgram , cpphsProgram , hscolourProgram , haddockProgram , greencardProgram , ldProgram , tarProgram , cppProgram , pfesetupProgram , pkgConfigProgram ) where import qualified Distribution.Compat.Map as Map import Distribution.Compat.Directory (findExecutable) import Distribution.Compat.TempFile (withTempFile) import Distribution.Simple.Utils (die, debug, warn, rawSystemExit, rawSystemStdout, rawSystemStdout') import Distribution.Version (Version(..), readVersion, showVersion, VersionRange(..), withinRange, showVersionRange) import Distribution.Verbosity import System.Directory (doesFileExist, removeFile) import System.FilePath (dropExtension) import System.IO.Error (try) import Control.Monad (join, foldM) import Control.Exception as Exception (catch) -- | Represents a program which can be configured. data Program = Program { -- | The simple name of the program, eg. ghc programName :: String, -- | A function to search for the program if it's location was not -- specified by the user. Usually this will just be a programFindLocation :: Verbosity -> IO (Maybe FilePath), -- | Try to find the version of the program. For many programs this is -- not possible or is not necessary so it's ok to return Nothing. programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version) } type ProgArg = String data ConfiguredProgram = ConfiguredProgram { -- | Just the name again programId :: String, -- | The version of this program, if it is known. programVersion :: Maybe Version, -- | Default command-line args for this program. -- These flags will appear first on the command line, so they can be -- overridden by subsequent flags. programArgs :: [ProgArg], -- | Location of the program. eg. @\/usr\/bin\/ghc-6.4@ programLocation :: ProgramLocation } deriving (Read, Show) -- | Where a program was found. Also tells us whether it's specifed by user or -- not. This includes not just the path, but the program as well. data ProgramLocation = UserSpecified { locationPath :: FilePath } -- ^The user gave the path to this program, -- eg. --ghc-path=\/usr\/bin\/ghc-6.6 | FoundOnSystem { locationPath :: FilePath } -- ^The location of the program, as located by searching PATH. deriving (Read, Show) -- ------------------------------------------------------------ -- * Programs functions -- ------------------------------------------------------------ -- | The full path of a configured program. programPath :: ConfiguredProgram -> FilePath programPath = locationPath . programLocation -- | Make a simple named program. -- -- By default we'll just search for it in the path and not try to find the -- version name. You can override these behaviours if necessary, eg: -- -- > simpleProgram "foo" { programFindLocation = ... , programFindVersion ... } -- simpleProgram :: String -> Program simpleProgram name = Program name (findProgramOnPath name) (\_ _ -> return Nothing) -- | Look for a program on the path. findProgramOnPath :: FilePath -> Verbosity -> IO (Maybe FilePath) findProgramOnPath prog verbosity = do debug verbosity $ "searching for " ++ prog ++ " in path." res <- findExecutable prog case res of Nothing -> debug verbosity ("Cannot find " ++ prog ++ " on the path") Just path -> debug verbosity ("found " ++ prog ++ " at "++ path) return res -- | Look for a program and try to find it's version number. It can accept -- either an absolute path or the name of a program binary, in which case we -- will look for the program on the path. -- findProgramVersion :: ProgArg -- ^ version args -> (String -> String) -- ^ function to select version -- number from program output -> Verbosity -> FilePath -- ^ location -> IO (Maybe Version) findProgramVersion versionArg selectVersion verbosity path = do str <- rawSystemStdout verbosity path [versionArg] `Exception.catch` \_ -> return "" let version = readVersion (selectVersion str) case version of Nothing -> warn verbosity $ "cannot determine version of " ++ path ++ " :\n" ++ show str Just v -> debug verbosity $ path ++ " is version " ++ showVersion v return version -- ------------------------------------------------------------ -- * Programs database -- ------------------------------------------------------------ -- | The configuration is a collection of information about programs. It -- contains information both about configured programs and also about programs -- that we are yet to configure. -- -- The idea is that we start from a collection of unconfigured programs and one -- by one we try to configure them at which point we move them into the -- configured collection. For unconfigured programs we record not just the -- 'Program' but also any user-provided arguments and location for the program. data ProgramConfiguration = ProgramConfiguration { unconfiguredProgs :: UnconfiguredProgs, configuredProgs :: ConfiguredProgs } type UnconfiguredProgram = (Program, Maybe FilePath, [ProgArg]) type UnconfiguredProgs = Map.Map String UnconfiguredProgram type ConfiguredProgs = Map.Map String ConfiguredProgram emptyProgramConfiguration :: ProgramConfiguration emptyProgramConfiguration = ProgramConfiguration Map.empty Map.empty defaultProgramConfiguration :: ProgramConfiguration defaultProgramConfiguration = foldl (flip addKnownProgram) emptyProgramConfiguration builtinPrograms -- internal helpers: updateUnconfiguredProgs :: (UnconfiguredProgs -> UnconfiguredProgs) -> ProgramConfiguration -> ProgramConfiguration updateUnconfiguredProgs update conf = conf { unconfiguredProgs = update (unconfiguredProgs conf) } updateConfiguredProgs :: (ConfiguredProgs -> ConfiguredProgs) -> ProgramConfiguration -> ProgramConfiguration updateConfiguredProgs update conf = conf { configuredProgs = update (configuredProgs conf) } -- Read & Show instances are based on listToFM -- Note that we only serialise the configured part of the database, this is -- because we don't need the unconfigured part after the configure stage, and -- additionally because we cannot read/show 'Program' as it contains functions. instance Show ProgramConfiguration where show = show . Map.toAscList . configuredProgs instance Read ProgramConfiguration where readsPrec p s = [ (emptyProgramConfiguration { configuredProgs = Map.fromList s' }, r) | (s', r) <- readsPrec p s ] -- ------------------------------- -- Managing unconfigured programs -- | Add a known program that we may configure later addKnownProgram :: Program -> ProgramConfiguration -> ProgramConfiguration addKnownProgram prog = updateUnconfiguredProgs $ Map.insert (programName prog) (prog, Nothing, []) lookupKnownProgram :: String -> ProgramConfiguration -> Maybe Program lookupKnownProgram name = fmap (\(p,_,_)->p) . Map.lookup name . unconfiguredProgs knownPrograms :: ProgramConfiguration -> [(Program, Maybe ConfiguredProgram)] knownPrograms conf = [ (p,p') | (p,_,_) <- Map.elems (unconfiguredProgs conf) , let p' = Map.lookup (programName p) (configuredProgs conf) ] -- |User-specify this path. Basically override any path information -- for this program in the configuration. If it's not a known -- program ignore it. userSpecifyPath :: String -- ^Program name -> FilePath -- ^user-specified path to the program -> ProgramConfiguration -> ProgramConfiguration userSpecifyPath name path = updateUnconfiguredProgs $ flip Map.update name $ \(prog, _, args) -> Just (prog, Just path, args) userMaybeSpecifyPath :: String -> Maybe FilePath -> ProgramConfiguration -> ProgramConfiguration userMaybeSpecifyPath _ Nothing conf = conf userMaybeSpecifyPath name (Just path) conf = userSpecifyPath name path conf -- |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, ignore it.. userSpecifyArgs :: String -- ^Program name -> [ProgArg] -- ^user-specified args -> ProgramConfiguration -> ProgramConfiguration userSpecifyArgs name args' = updateUnconfiguredProgs (flip Map.update name $ \(prog, path, args) -> Just (prog, path, args ++ args')) . updateConfiguredProgs (flip Map.update name $ \prog -> Just prog { programArgs = programArgs prog ++ args' }) userSpecifiedPath :: Program -> ProgramConfiguration -> Maybe FilePath userSpecifiedPath prog = join . fmap (\(_,p,_)->p) . Map.lookup (programName prog) . unconfiguredProgs userSpecifiedArgs :: Program -> ProgramConfiguration -> [ProgArg] userSpecifiedArgs prog = maybe [] (\(_,_,as)->as) . Map.lookup (programName prog) . unconfiguredProgs -- ----------------------------- -- Managing configured programs -- | Try to find a configured program lookupProgram :: Program -> ProgramConfiguration -> Maybe ConfiguredProgram lookupProgram prog = Map.lookup (programName prog) . configuredProgs -- | Update a configured program in the database. updateProgram :: ConfiguredProgram -> ProgramConfiguration -> ProgramConfiguration updateProgram prog = updateConfiguredProgs $ Map.insert (programId prog) prog -- --------------------------- -- Configuring known programs -- | Try to configure a specific program. If the program is already included in -- the colleciton of unconfigured programs then we use any user-supplied -- location and arguments. If the program gets configured sucessfully it gets -- added to the configured collection. -- -- Note that it is not a failure if the program cannot be configured. It's only -- a failure if the user supplied a location and the program could not be found -- at that location. -- -- The reason for it not being a failure at this stage is that we don't know up -- front all the programs we will need, so we try to configure them all. -- To verify that a program was actually sucessfully configured use -- 'requireProgram'. -- configureProgram :: Verbosity -> Program -> ProgramConfiguration -> IO ProgramConfiguration configureProgram verbosity prog conf = do let name = programName prog maybeLocation <- case userSpecifiedPath prog conf of Nothing -> programFindLocation prog verbosity >>= return . fmap FoundOnSystem Just path -> do absolute <- doesFileExist path if absolute then return (Just (UserSpecified path)) else findProgramOnPath path verbosity >>= maybe (die notFound) (return . Just . UserSpecified) where notFound = "Cannot find " ++ name ++ " at " ++ path ++ " or on the path" case maybeLocation of Nothing -> return conf Just location -> do version <- programFindVersion prog verbosity (locationPath location) let configuredProg = ConfiguredProgram { programId = name, programVersion = version, programArgs = userSpecifiedArgs prog conf, programLocation = location } return (updateConfiguredProgs (Map.insert name configuredProg) conf) -- | Try to configure all the known programs that have not yet been configured. configureAllKnownPrograms :: Verbosity -> ProgramConfiguration -> IO ProgramConfiguration configureAllKnownPrograms verbosity conf = foldM (flip (configureProgram verbosity)) conf [ prog | (prog,_,_) <- Map.elems (unconfiguredProgs conf `Map.difference` configuredProgs conf) ] -- | Check that a program is configured and available to be run. -- -- Additionally check that the version of the program number is suitable. -- For example 'AnyVersion' or @'orLaterVersion' ('Version' [1,0] [])@ -- -- It raises an exception if the program could not be configured or the version -- is unsuitable, otherwise it returns the configured program. requireProgram :: Verbosity -> Program -> VersionRange -> ProgramConfiguration -> IO (ConfiguredProgram, ProgramConfiguration) requireProgram verbosity prog range conf = do -- If it's not already been configured, try to configure it now conf' <- case lookupProgram prog conf of Nothing -> configureProgram verbosity prog conf Just _ -> return conf case lookupProgram prog conf' of Nothing -> die notFound Just configuredProg | range == AnyVersion -> return (configuredProg, conf') Just configuredProg@ConfiguredProgram { programLocation = location } -> case programVersion configuredProg of Just version | withinRange version range -> return (configuredProg, conf') | otherwise -> die (badVersion version location) Nothing -> die (noVersion location) where notFound = programName prog ++ versionRequirement ++ " is required but it could not be found." badVersion v l = programName prog ++ versionRequirement ++ " is required but the version found at " ++ locationPath l ++ " is version " ++ showVersion v noVersion l = programName prog ++ versionRequirement ++ " is required but the version of " ++ locationPath l ++ " could not be determined." versionRequirement | range == AnyVersion = "" | otherwise = " version " ++ showVersionRange range -- ------------------------------------------------------------ -- * Running programs -- ------------------------------------------------------------ -- | Runs the given configured program. rawSystemProgram :: Verbosity -- ^Verbosity -> ConfiguredProgram -- ^The program to run -> [ProgArg] -- ^Any /extra/ arguments to add -> IO () rawSystemProgram verbosity prog extraArgs = rawSystemExit verbosity (programPath prog) (programArgs prog ++ extraArgs) -- | Runs the given configured program and gets the output. rawSystemProgramStdout :: Verbosity -- ^Verbosity -> ConfiguredProgram -- ^The program to run -> [ProgArg] -- ^Any /extra/ arguments to add -> IO String rawSystemProgramStdout verbosity prog extraArgs = rawSystemStdout verbosity (programPath prog) (programArgs prog ++ extraArgs) -- | Looks up the given program in the program configuration and runs it. rawSystemProgramConf :: Verbosity -- ^verbosity -> Program -- ^The program to run -> ProgramConfiguration -- ^look up the program here -> [ProgArg] -- ^Any /extra/ arguments to add -> IO () rawSystemProgramConf verbosity prog programConf extraArgs = case lookupProgram prog programConf of Nothing -> die ("The program " ++ programName prog ++ " is required but it could not be found") Just configuredProg -> rawSystemProgram verbosity configuredProg extraArgs -- | Looks up the given program in the program configuration and runs it. rawSystemProgramStdoutConf :: Verbosity -- ^verbosity -> Program -- ^The program to run -> ProgramConfiguration -- ^look up the program here -> [ProgArg] -- ^Any /extra/ arguments to add -> IO String rawSystemProgramStdoutConf verbosity prog programConf extraArgs = case lookupProgram prog programConf of Nothing -> die ("The program " ++ programName prog ++ " is required but it could not be found") Just configuredProg -> rawSystemProgramStdout verbosity configuredProg extraArgs -- ------------------------------------------------------------ -- * Known programs -- ------------------------------------------------------------ -- | The default list of programs. -- These programs are typically used internally to Cabal. builtinPrograms :: [Program] builtinPrograms = [ -- compilers and related progs ghcProgram , ghcPkgProgram , hugsProgram , ffihugsProgram , nhcProgram , hmakeProgram , jhcProgram -- preprocessors , hscolourProgram , haddockProgram , happyProgram , alexProgram , hsc2hsProgram , c2hsProgram , cpphsProgram , greencardProgram , pfesetupProgram -- platform toolchain , ranlibProgram , arProgram , ldProgram , tarProgram -- configuration tools , pkgConfigProgram ] ghcProgram :: Program ghcProgram = (simpleProgram "ghc") { programFindVersion = findProgramVersion "--numeric-version" id } ghcPkgProgram :: Program ghcPkgProgram = (simpleProgram "ghc-pkg") { programFindVersion = findProgramVersion "--version" $ \str -> -- Invoking "ghc-pkg --version" gives a string like -- "GHC package manager version 6.4.1" case words str of (_:_:_:_:ver:_) -> ver _ -> "" } nhcProgram :: Program nhcProgram = simpleProgram "nhc98" hmakeProgram :: Program hmakeProgram = (simpleProgram "hmake") { programFindVersion = findProgramVersion "--version" $ \str -> case words str of (_:ver:_) -> ver _ -> "" } jhcProgram :: Program jhcProgram = (simpleProgram "jhc") { programFindVersion = findProgramVersion "--version" $ \str -> case words str of (_:ver:_) -> ver _ -> "" } -- AArgh! Finding the version of hugs or ffihugs is almost impossible. hugsProgram :: Program hugsProgram = simpleProgram "hugs" ffihugsProgram :: Program ffihugsProgram = simpleProgram "ffihugs" happyProgram :: Program happyProgram = (simpleProgram "happy") { programFindVersion = findProgramVersion "--version" $ \str -> -- Invoking "happy --version" gives a string like -- "Happy Version 1.16 Copyright (c) ...." case words str of (_:_:ver:_) -> ver _ -> "" } alexProgram :: Program alexProgram = (simpleProgram "alex") { programFindVersion = findProgramVersion "--version" $ \str -> -- Invoking "alex --version" gives a string like -- "Alex version 2.1.0, (c) 2003 Chris Dornan and Simon Marlow" case words str of (_:_:ver:_) -> takeWhile (`elem` ('.':['0'..'9'])) ver _ -> "" } ranlibProgram :: Program ranlibProgram = simpleProgram "ranlib" arProgram :: Program arProgram = simpleProgram "ar" hsc2hsProgram :: Program hsc2hsProgram = (simpleProgram "hsc2hs") { programFindVersion = \verbosity path -> do maybeVersion <- findProgramVersion "--version" (\str -> -- Invoking "hsc2hs --version" gives a string like "hsc2hs version 0.66" case words str of (_:_:ver:_) -> ver _ -> "") verbosity path -- It turns out that it's important to know if hsc2hs is using gcc or ghc -- as it's C compiler since this affects how we escape C options. -- So here's a cunning hack, we make a temp .hsc file and call: -- hsch2s tmp.hsc --cflag=--version -- which passes --version through to ghc/gcc and we look at the result -- to see if it was indeed ghc or not. case maybeVersion of Nothing -> return Nothing Just version -> withTempFile "dist" "hsc" $ \hsc -> do writeFile hsc "" (str, _) <- rawSystemStdout' verbosity path [hsc, "--cflag=--version"] try $ removeFile (dropExtension hsc ++ "_hsc_make.c") case words str of (_:"Glorious":"Glasgow":"Haskell":_) -> return $ Just version { versionTags = ["ghc"] } _ -> return $ Just version } c2hsProgram :: Program c2hsProgram = (simpleProgram "c2hs") { programFindVersion = findProgramVersion "--numeric-version" id } cpphsProgram :: Program cpphsProgram = (simpleProgram "cpphs") { programFindVersion = findProgramVersion "--version" $ \str -> -- Invoking "cpphs --version" gives a string like "cpphs 1.3" case words str of (_:ver:_) -> ver _ -> "" } hscolourProgram :: Program hscolourProgram = (simpleProgram "hscolour") { programFindLocation = findProgramOnPath "HsColour", programFindVersion = findProgramVersion "-version" $ \str -> -- Invoking "HsColour -version" gives a string like "HsColour 1.7" case words str of (_:ver:_) -> ver _ -> "" } haddockProgram :: Program haddockProgram = (simpleProgram "haddock") { programFindVersion = findProgramVersion "--version" $ \str -> -- Invoking "haddock --version" gives a string like -- "Haddock version 0.8, (c) Simon Marlow 2006" case words str of (_:_:ver:_) -> takeWhile (`elem` ('.':['0'..'9'])) ver _ -> "" } greencardProgram :: Program greencardProgram = simpleProgram "greencard" ldProgram :: Program ldProgram = simpleProgram "ld" tarProgram :: Program tarProgram = simpleProgram "tar" cppProgram :: Program cppProgram = simpleProgram "cpp" pfesetupProgram :: Program pfesetupProgram = simpleProgram "pfesetup" pkgConfigProgram :: Program pkgConfigProgram = (simpleProgram "pkg-config") { programFindVersion = findProgramVersion "--version" id }