Commit 5556d48d authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Split the Program module up a bit

Add an explicit intermediate ProgramInvocation data type.
parent 9b371f7b
This diff is collapsed.
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Program.Builtin
-- Copyright : Isaac Jones 2006, Duncan Coutts 2007-2009
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- The module defines all the known built-in 'Program's.
--
-- Where possible we try to find their version numbers.
--
module Distribution.Simple.Program.Builtin (
-- * The collection of unconfigured and configured progams
builtinPrograms,
-- * Programs that Cabal knows about
ghcProgram,
ghcPkgProgram,
lhcProgram,
lhcPkgProgram,
nhcProgram,
hmakeProgram,
jhcProgram,
hugsProgram,
ffihugsProgram,
gccProgram,
ranlibProgram,
arProgram,
stripProgram,
happyProgram,
alexProgram,
hsc2hsProgram,
c2hsProgram,
cpphsProgram,
hscolourProgram,
haddockProgram,
greencardProgram,
ldProgram,
tarProgram,
cppProgram,
pkgConfigProgram,
) where
import Distribution.Simple.Program.Types
( Program(..), simpleProgram )
import Distribution.Simple.Utils
( findProgramOnPath, findProgramVersion )
-- ------------------------------------------------------------
-- * 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
, lhcProgram
, lhcPkgProgram
-- preprocessors
, hscolourProgram
, haddockProgram
, happyProgram
, alexProgram
, hsc2hsProgram
, c2hsProgram
, cpphsProgram
, greencardProgram
-- platform toolchain
, gccProgram
, ranlibProgram
, arProgram
, stripProgram
, 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
_ -> ""
}
lhcProgram :: Program
lhcProgram = (simpleProgram "lhc") {
programFindVersion = findProgramVersion "--numeric-version" id
}
lhcPkgProgram :: Program
lhcPkgProgram = (simpleProgram "lhc-pkg") {
programFindVersion = findProgramVersion "--version" $ \str ->
-- Invoking "lhc-pkg --version" gives a string like
-- "LHC package manager version 0.7"
case words str of
(_:_:_:_:ver:_) -> ver
_ -> ""
}
nhcProgram :: Program
nhcProgram = (simpleProgram "nhc98") {
programFindVersion = findProgramVersion "--version" $ \str ->
-- Invoking "nhc98 --version" gives a string like
-- "/usr/local/bin/nhc98: v1.20 (2007-11-22)"
case words str of
(_:('v':ver):_) -> ver
_ -> ""
}
hmakeProgram :: Program
hmakeProgram = (simpleProgram "hmake") {
programFindVersion = findProgramVersion "--version" $ \str ->
-- Invoking "hmake --version" gives a string line
-- "/usr/local/bin/hmake: 3.13 (2006-11-01)"
case words str of
(_:ver:_) -> ver
_ -> ""
}
jhcProgram :: Program
jhcProgram = (simpleProgram "jhc") {
programFindVersion = findProgramVersion "--version" $ \str ->
-- invoking "jhc --version" gives a string like
-- "jhc 0.3.20080208 (wubgipkamcep-2)
-- compiled by ghc-6.8 on a x86_64 running linux"
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
_ -> ""
}
gccProgram :: Program
gccProgram = (simpleProgram "gcc") {
programFindVersion = findProgramVersion "-dumpversion" id
}
ranlibProgram :: Program
ranlibProgram = simpleProgram "ranlib"
arProgram :: Program
arProgram = simpleProgram "ar"
stripProgram :: Program
stripProgram = simpleProgram "strip"
hsc2hsProgram :: Program
hsc2hsProgram = (simpleProgram "hsc2hs") {
programFindVersion =
findProgramVersion "--version" $ \str ->
-- Invoking "hsc2hs --version" gives a string like "hsc2hs version 0.66"
case words str of
(_:_:ver:_) -> ver
_ -> ""
}
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 = \v -> findProgramOnPath v "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"
pkgConfigProgram :: Program
pkgConfigProgram = (simpleProgram "pkg-config") {
programFindVersion = findProgramVersion "--version" id
}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Program.Db
-- Copyright : Isaac Jones 2006, Duncan Coutts 2007-2009
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- This provides a 'ProgramDb' type which holds configured and not-yet
-- configured programs. It is the parameter to lots of actions elsewhere in
-- Cabal that need to look up and run programs. If we had a Cabal monad,
-- the 'ProgramDb' would probably be a reader or state component of it.
--
-- 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 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.Db (
-- * The collection of configured programs we can run
ProgramDb,
emptyProgramDb,
defaultProgramDb,
restoreProgramDb,
-- ** Query and manipulate the program db
addKnownProgram,
addKnownPrograms,
lookupKnownProgram,
knownPrograms,
userSpecifyPath,
userSpecifyPaths,
userMaybeSpecifyPath,
userSpecifyArgs,
userSpecifyArgss,
userSpecifiedArgs,
lookupProgram,
updateProgram,
-- ** Query and manipulate the program db
configureProgram,
configureAllKnownPrograms,
reconfigurePrograms,
requireProgram,
requireProgramVersion,
) where
import Distribution.Simple.Program.Types
( Program(..), ProgArg, ConfiguredProgram(..), ProgramLocation(..) )
import Distribution.Simple.Program.Builtin
( builtinPrograms )
import Distribution.Simple.Utils
( die, findProgramOnPath )
import Distribution.Version
( Version, VersionRange, isAnyVersion, withinRange )
import Distribution.Text
( display )
import Distribution.Verbosity
( Verbosity )
import Data.List
( foldl' )
import Data.Maybe
( catMaybes )
import qualified Data.Map as Map
import Control.Monad
( join, foldM )
import System.Directory
( doesFileExist )
-- ------------------------------------------------------------
-- * 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 ProgramDb = ProgramDb {
unconfiguredProgs :: UnconfiguredProgs,
configuredProgs :: ConfiguredProgs
}
type UnconfiguredProgram = (Program, Maybe FilePath, [ProgArg])
type UnconfiguredProgs = Map.Map String UnconfiguredProgram
type ConfiguredProgs = Map.Map String ConfiguredProgram
emptyProgramDb :: ProgramDb
emptyProgramDb = ProgramDb Map.empty Map.empty
defaultProgramDb :: ProgramDb
defaultProgramDb = restoreProgramDb builtinPrograms emptyProgramDb
-- internal helpers:
updateUnconfiguredProgs :: (UnconfiguredProgs -> UnconfiguredProgs)
-> ProgramDb -> ProgramDb
updateUnconfiguredProgs update conf =
conf { unconfiguredProgs = update (unconfiguredProgs conf) }
updateConfiguredProgs :: (ConfiguredProgs -> ConfiguredProgs)
-> ProgramDb -> ProgramDb
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 ProgramDb where
show = show . Map.toAscList . configuredProgs
instance Read ProgramDb where
readsPrec p s =
[ (emptyProgramDb { configuredProgs = Map.fromList s' }, r)
| (s', r) <- readsPrec p s ]
-- | The Read\/Show instance does not preserve all the unconfigured 'Programs'
-- because 'Program' is not in Read\/Show because it contains functions. So to
-- fully restore a deserialised 'ProgramDb' use this function to add
-- back all the known 'Program's.
--
-- * It does not add the default programs, but you probably want them, use
-- 'builtinPrograms' in addition to any extra you might need.
--
restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb
restoreProgramDb = addKnownPrograms
-- -------------------------------
-- Managing unconfigured programs
-- | Add a known program that we may configure later
--
addKnownProgram :: Program -> ProgramDb -> ProgramDb
addKnownProgram prog = updateUnconfiguredProgs $
Map.insertWith combine (programName prog) (prog, Nothing, [])
where combine _ (_, path, args) = (prog, path, args)
addKnownPrograms :: [Program] -> ProgramDb -> ProgramDb
addKnownPrograms progs conf = foldl' (flip addKnownProgram) conf progs
lookupKnownProgram :: String -> ProgramDb -> Maybe Program
lookupKnownProgram name =
fmap (\(p,_,_)->p) . Map.lookup name . unconfiguredProgs
knownPrograms :: ProgramDb -> [(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
-> ProgramDb -> ProgramDb
userSpecifyPath name path = updateUnconfiguredProgs $
flip Map.update name $ \(prog, _, args) -> Just (prog, Just path, args)
userMaybeSpecifyPath :: String -> Maybe FilePath
-> ProgramDb -> ProgramDb
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
-> ProgramDb
-> ProgramDb
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' })
-- | Like 'userSpecifyPath' but for a list of progs and their paths.
--
userSpecifyPaths :: [(String, FilePath)]
-> ProgramDb
-> ProgramDb
userSpecifyPaths paths conf =
foldl' (\conf' (prog, path) -> userSpecifyPath prog path conf') conf paths
-- | Like 'userSpecifyPath' but for a list of progs and their args.
--
userSpecifyArgss :: [(String, [ProgArg])]
-> ProgramDb
-> ProgramDb
userSpecifyArgss argss conf =
foldl' (\conf' (prog, args) -> userSpecifyArgs prog args conf') conf argss
-- | Get the path that has been previously specified for a program, if any.
--
userSpecifiedPath :: Program -> ProgramDb -> Maybe FilePath
userSpecifiedPath prog =
join . fmap (\(_,p,_)->p) . Map.lookup (programName prog) . unconfiguredProgs
-- | Get any extra args that have been previously specified for a program.
--
userSpecifiedArgs :: Program -> ProgramDb -> [ProgArg]
userSpecifiedArgs prog =
maybe [] (\(_,_,as)->as) . Map.lookup (programName prog) . unconfiguredProgs
-- -----------------------------
-- Managing configured programs
-- | Try to find a configured program
lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram prog = Map.lookup (programName prog) . configuredProgs
-- | Update a configured program in the database.
updateProgram :: ConfiguredProgram -> ProgramDb
-> ProgramDb
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
-> ProgramDb
-> IO ProgramDb
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 verbosity path
>>= maybe (die notFound) (return . Just . UserSpecified)
where notFound = "Cannot find the program '" ++ 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
}
extraArgs <- programPostConf prog verbosity configuredProg
let configuredProg' = configuredProg {
programArgs = extraArgs ++ programArgs configuredProg
}
return (updateConfiguredProgs (Map.insert name configuredProg') conf)
-- | Configure a bunch of programs using 'configureProgram'. Just a 'foldM'.
--
configurePrograms :: Verbosity
-> [Program]
-> ProgramDb
-> IO ProgramDb
configurePrograms verbosity progs conf =
foldM (flip (configureProgram verbosity)) conf progs
-- | Try to configure all the known programs that have not yet been configured.
--
configureAllKnownPrograms :: Verbosity
-> ProgramDb
-> IO ProgramDb
configureAllKnownPrograms verbosity conf =
configurePrograms verbosity
[ prog | (prog,_,_) <- Map.elems notYetConfigured ] conf
where
notYetConfigured = unconfiguredProgs conf
`Map.difference` configuredProgs conf
-- | reconfigure a bunch of programs given new user-specified args. It takes
-- the same inputs as 'userSpecifyPath' and 'userSpecifyArgs' and for all progs
-- with a new path it calls 'configureProgram'.
--
reconfigurePrograms :: Verbosity
-> [(String, FilePath)]
-> [(String, [ProgArg])]
-> ProgramDb
-> IO ProgramDb
reconfigurePrograms verbosity paths argss conf = do
configurePrograms verbosity progs
. userSpecifyPaths paths
. userSpecifyArgss argss
$ conf
where
progs = catMaybes [ lookupKnownProgram name conf | (name,_) <- paths ]
-- | Check that a program is configured and available to be run.
--
-- It raises an exception if the program could not be configured, otherwise
-- it returns the configured program.
--
requireProgram :: Verbosity -> Program -> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)
requireProgram verbosity prog 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 -> return (configuredProg, conf')
where notFound = programName prog
++ " is required but it could not be found."