{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- 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, getProgramSearchPath, setProgramSearchPath, modifyProgramSearchPath, userSpecifyPath, userSpecifyPaths, userMaybeSpecifyPath, userSpecifyArgs, userSpecifyArgss, userSpecifiedArgs, lookupProgram, updateProgram, configuredPrograms, -- ** Query and manipulate the program db configureProgram, configureAllKnownPrograms, lookupProgramVersion, reconfigurePrograms, requireProgram, requireProgramVersion, ) where import Distribution.Simple.Program.Types ( Program(..), ProgArg, ConfiguredProgram(..), ProgramLocation(..) ) import Distribution.Simple.Program.Find ( ProgramSearchPath, defaultProgramSearchPath , findProgramOnSearchPath, programSearchPathAsPATHVar ) import Distribution.Simple.Program.Builtin ( builtinPrograms ) import Distribution.Simple.Utils ( die, doesExecutableExist ) import Distribution.Version ( Version, VersionRange, isAnyVersion, withinRange ) import Distribution.Text ( display ) import Distribution.Verbosity ( Verbosity ) import Distribution.Compat.Binary (Binary(..)) #if __GLASGOW_HASKELL__ < 710 import Data.Functor ((<$>)) #endif import Data.List ( foldl' ) import Data.Maybe ( catMaybes ) import qualified Data.Map as Map import Control.Monad ( join, foldM ) -- ------------------------------------------------------------ -- * 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, progSearchPath :: ProgramSearchPath, 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 defaultProgramSearchPath 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 ] instance Binary ProgramDb where put = put . configuredProgs get = do progs <- get return $! emptyProgramDb { configuredProgs = progs } -- | 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) ] -- | Get the current 'ProgramSearchPath' used by the 'ProgramDb'. -- This is the default list of locations where programs are looked for when -- configuring them. This can be overridden for specific programs (with -- 'userSpecifyPath'), and specific known programs can modify or ignore this -- search path in their own configuration code. -- getProgramSearchPath :: ProgramDb -> ProgramSearchPath getProgramSearchPath = progSearchPath -- | Change the current 'ProgramSearchPath' used by the 'ProgramDb'. -- This will affect programs that are configured from here on, so you -- should usually set it before configuring any programs. -- setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb setProgramSearchPath searchpath db = db { progSearchPath = searchpath } -- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'. -- This will affect programs that are configured from here on, so you -- should usually modify it before configuring any programs. -- modifyProgramSearchPath :: (ProgramSearchPath -> ProgramSearchPath) -> ProgramDb -> ProgramDb modifyProgramSearchPath f db = setProgramSearchPath (f $ getProgramSearchPath db) db -- |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 { programOverrideArgs = programOverrideArgs 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 -- | List all configured programs. configuredPrograms :: ProgramDb -> [ConfiguredProgram] configuredPrograms = Map.elems . configuredProgs -- --------------------------- -- Configuring known programs -- | Try to configure a specific program. If the program is already included in -- the collection of unconfigured programs then we use any user-supplied -- location and arguments. If the program gets configured successfully 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 successfully 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 (progSearchPath conf) >>= return . fmap FoundOnSystem Just path -> do absolute <- doesExecutableExist path if absolute then return (Just (UserSpecified path)) else findProgramOnSearchPath verbosity (progSearchPath conf) path >>= maybe (die notFound) (return . Just . UserSpecified) where notFound = "Cannot find the program '" ++ name ++ "'. User-specified path '" ++ path ++ "' does not refer to an executable and " ++ "the program is not on the system path." case maybeLocation of Nothing -> return conf Just location -> do version <- programFindVersion prog verbosity (locationPath location) newPath <- programSearchPathAsPATHVar (progSearchPath conf) let configuredProg = ConfiguredProgram { programId = name, programVersion = version, programDefaultArgs = [], programOverrideArgs = userSpecifiedArgs prog conf, programOverrideEnv = [("PATH", Just newPath)], programProperties = Map.empty, programLocation = location } configuredProg' <- programPostConf prog verbosity 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 = "The program '" ++ programName prog ++ "' is required but it could not be found." -- | Check that a program is configured and available to be run. -- -- Additionally check that the program version number is suitable and return -- it. For example you could require 'AnyVersion' or @'orLaterVersion' -- ('Version' [1,0] [])@ -- -- It returns the configured program, its version number and a possibly updated -- 'ProgramDb'. If the program could not be configured or the version is -- unsuitable, it returns an error value. -- lookupProgramVersion :: Verbosity -> Program -> VersionRange -> ProgramDb -> IO (Either String (ConfiguredProgram, Version, ProgramDb)) lookupProgramVersion verbosity prog range programDb = do -- If it's not already been configured, try to configure it now programDb' <- case lookupProgram prog programDb of Nothing -> configureProgram verbosity prog programDb Just _ -> return programDb case lookupProgram prog programDb' of Nothing -> return $! Left notFound Just configuredProg@ConfiguredProgram { programLocation = location } -> case programVersion configuredProg of Just version | withinRange version range -> return $! Right (configuredProg, version ,programDb') | otherwise -> return $! Left (badVersion version location) Nothing -> return $! Left (noVersion location) where notFound = "The program '" ++ programName prog ++ "'" ++ versionRequirement ++ " is required but it could not be found." badVersion v l = "The program '" ++ programName prog ++ "'" ++ versionRequirement ++ " is required but the version found at " ++ locationPath l ++ " is version " ++ display v noVersion l = "The program '" ++ programName prog ++ "'" ++ versionRequirement ++ " is required but the version of " ++ locationPath l ++ " could not be determined." versionRequirement | isAnyVersion range = "" | otherwise = " version " ++ display range -- | Like 'lookupProgramVersion', but raises an exception in case of error -- instead of returning 'Left errMsg'. -- requireProgramVersion :: Verbosity -> Program -> VersionRange -> ProgramDb -> IO (ConfiguredProgram, Version, ProgramDb) requireProgramVersion verbosity prog range programDb = join $ either die return <$> lookupProgramVersion verbosity prog range programDb