1{-# LANGUAGE FlexibleContexts #-} 2{-# LANGUAGE RankNTypes #-} 3{-# LANGUAGE DeriveDataTypeable #-} 4 5----------------------------------------------------------------------------- 6-- | 7-- Module : Distribution.Simple.Program.Db 8-- Copyright : Isaac Jones 2006, Duncan Coutts 2007-2009 9-- 10-- Maintainer : cabal-devel@haskell.org 11-- Portability : portable 12-- 13-- This provides a 'ProgramDb' type which holds configured and not-yet 14-- configured programs. It is the parameter to lots of actions elsewhere in 15-- Cabal that need to look up and run programs. If we had a Cabal monad, 16-- the 'ProgramDb' would probably be a reader or state component of it. 17-- 18-- One nice thing about using it is that any program that is 19-- registered with Cabal will get some \"configure\" and \".cabal\" 20-- helpers like --with-foo-args --foo-path= and extra-foo-args. 21-- 22-- There's also a hook for adding programs in a Setup.lhs script. See 23-- hookedPrograms in 'Distribution.Simple.UserHooks'. This gives a 24-- hook user the ability to get the above flags and such so that they 25-- don't have to write all the PATH logic inside Setup.lhs. 26 27module Distribution.Simple.Program.Db ( 28 -- * The collection of configured programs we can run 29 ProgramDb, 30 emptyProgramDb, 31 defaultProgramDb, 32 restoreProgramDb, 33 34 -- ** Query and manipulate the program db 35 addKnownProgram, 36 addKnownPrograms, 37 lookupKnownProgram, 38 knownPrograms, 39 getProgramSearchPath, 40 setProgramSearchPath, 41 modifyProgramSearchPath, 42 userSpecifyPath, 43 userSpecifyPaths, 44 userMaybeSpecifyPath, 45 userSpecifyArgs, 46 userSpecifyArgss, 47 userSpecifiedArgs, 48 lookupProgram, 49 updateProgram, 50 configuredPrograms, 51 52 -- ** Query and manipulate the program db 53 configureProgram, 54 configureAllKnownPrograms, 55 unconfigureProgram, 56 lookupProgramVersion, 57 reconfigurePrograms, 58 requireProgram, 59 requireProgramVersion, 60 needProgram, 61 62 ) where 63 64import Prelude () 65import Distribution.Compat.Prelude 66 67import Distribution.Simple.Program.Types 68import Distribution.Simple.Program.Find 69import Distribution.Simple.Program.Builtin 70import Distribution.Simple.Utils 71import Distribution.Version 72import Distribution.Pretty 73import Distribution.Verbosity 74 75import Control.Monad (join) 76import Data.Tuple (swap) 77import qualified Data.Map as Map 78 79-- ------------------------------------------------------------ 80-- * Programs database 81-- ------------------------------------------------------------ 82 83-- | The configuration is a collection of information about programs. It 84-- contains information both about configured programs and also about programs 85-- that we are yet to configure. 86-- 87-- The idea is that we start from a collection of unconfigured programs and one 88-- by one we try to configure them at which point we move them into the 89-- configured collection. For unconfigured programs we record not just the 90-- 'Program' but also any user-provided arguments and location for the program. 91data ProgramDb = ProgramDb { 92 unconfiguredProgs :: UnconfiguredProgs, 93 progSearchPath :: ProgramSearchPath, 94 configuredProgs :: ConfiguredProgs 95 } 96 deriving (Typeable) 97 98type UnconfiguredProgram = (Program, Maybe FilePath, [ProgArg]) 99type UnconfiguredProgs = Map.Map String UnconfiguredProgram 100type ConfiguredProgs = Map.Map String ConfiguredProgram 101 102 103emptyProgramDb :: ProgramDb 104emptyProgramDb = ProgramDb Map.empty defaultProgramSearchPath Map.empty 105 106defaultProgramDb :: ProgramDb 107defaultProgramDb = restoreProgramDb builtinPrograms emptyProgramDb 108 109 110-- internal helpers: 111updateUnconfiguredProgs :: (UnconfiguredProgs -> UnconfiguredProgs) 112 -> ProgramDb -> ProgramDb 113updateUnconfiguredProgs update progdb = 114 progdb { unconfiguredProgs = update (unconfiguredProgs progdb) } 115 116updateConfiguredProgs :: (ConfiguredProgs -> ConfiguredProgs) 117 -> ProgramDb -> ProgramDb 118updateConfiguredProgs update progdb = 119 progdb { configuredProgs = update (configuredProgs progdb) } 120 121 122-- Read & Show instances are based on listToFM 123 124-- | Note that this instance does not preserve the known 'Program's. 125-- See 'restoreProgramDb' for details. 126-- 127instance Show ProgramDb where 128 show = show . Map.toAscList . configuredProgs 129 130-- | Note that this instance does not preserve the known 'Program's. 131-- See 'restoreProgramDb' for details. 132-- 133instance Read ProgramDb where 134 readsPrec p s = 135 [ (emptyProgramDb { configuredProgs = Map.fromList s' }, r) 136 | (s', r) <- readsPrec p s ] 137 138-- | Note that this instance does not preserve the known 'Program's. 139-- See 'restoreProgramDb' for details. 140-- 141instance Binary ProgramDb where 142 put db = do 143 put (progSearchPath db) 144 put (configuredProgs db) 145 146 get = do 147 searchpath <- get 148 progs <- get 149 return $! emptyProgramDb { 150 progSearchPath = searchpath, 151 configuredProgs = progs 152 } 153 154 155-- | The 'Read'\/'Show' and 'Binary' instances do not preserve all the 156-- unconfigured 'Programs' because 'Program' is not in 'Read'\/'Show' because 157-- it contains functions. So to fully restore a deserialised 'ProgramDb' use 158-- this function to add back all the known 'Program's. 159-- 160-- * It does not add the default programs, but you probably want them, use 161-- 'builtinPrograms' in addition to any extra you might need. 162-- 163restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb 164restoreProgramDb = addKnownPrograms 165 166 167-- ------------------------------- 168-- Managing unconfigured programs 169 170-- | Add a known program that we may configure later 171-- 172addKnownProgram :: Program -> ProgramDb -> ProgramDb 173addKnownProgram prog = updateUnconfiguredProgs $ 174 Map.insertWith combine (programName prog) (prog, Nothing, []) 175 where combine _ (_, path, args) = (prog, path, args) 176 177 178addKnownPrograms :: [Program] -> ProgramDb -> ProgramDb 179addKnownPrograms progs progdb = foldl' (flip addKnownProgram) progdb progs 180 181 182lookupKnownProgram :: String -> ProgramDb -> Maybe Program 183lookupKnownProgram name = 184 fmap (\(p,_,_)->p) . Map.lookup name . unconfiguredProgs 185 186 187knownPrograms :: ProgramDb -> [(Program, Maybe ConfiguredProgram)] 188knownPrograms progdb = 189 [ (p,p') | (p,_,_) <- Map.elems (unconfiguredProgs progdb) 190 , let p' = Map.lookup (programName p) (configuredProgs progdb) ] 191 192-- | Get the current 'ProgramSearchPath' used by the 'ProgramDb'. 193-- This is the default list of locations where programs are looked for when 194-- configuring them. This can be overridden for specific programs (with 195-- 'userSpecifyPath'), and specific known programs can modify or ignore this 196-- search path in their own configuration code. 197-- 198getProgramSearchPath :: ProgramDb -> ProgramSearchPath 199getProgramSearchPath = progSearchPath 200 201-- | Change the current 'ProgramSearchPath' used by the 'ProgramDb'. 202-- This will affect programs that are configured from here on, so you 203-- should usually set it before configuring any programs. 204-- 205setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb 206setProgramSearchPath searchpath db = db { progSearchPath = searchpath } 207 208-- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'. 209-- This will affect programs that are configured from here on, so you 210-- should usually modify it before configuring any programs. 211-- 212modifyProgramSearchPath :: (ProgramSearchPath -> ProgramSearchPath) 213 -> ProgramDb 214 -> ProgramDb 215modifyProgramSearchPath f db = 216 setProgramSearchPath (f $ getProgramSearchPath db) db 217 218-- |User-specify this path. Basically override any path information 219-- for this program in the configuration. If it's not a known 220-- program ignore it. 221-- 222userSpecifyPath :: String -- ^Program name 223 -> FilePath -- ^user-specified path to the program 224 -> ProgramDb -> ProgramDb 225userSpecifyPath name path = updateUnconfiguredProgs $ 226 flip Map.update name $ \(prog, _, args) -> Just (prog, Just path, args) 227 228 229userMaybeSpecifyPath :: String -> Maybe FilePath 230 -> ProgramDb -> ProgramDb 231userMaybeSpecifyPath _ Nothing progdb = progdb 232userMaybeSpecifyPath name (Just path) progdb = userSpecifyPath name path progdb 233 234 235-- |User-specify the arguments for this program. Basically override 236-- any args information for this program in the configuration. If it's 237-- not a known program, ignore it.. 238userSpecifyArgs :: String -- ^Program name 239 -> [ProgArg] -- ^user-specified args 240 -> ProgramDb 241 -> ProgramDb 242userSpecifyArgs name args' = 243 updateUnconfiguredProgs 244 (flip Map.update name $ 245 \(prog, path, args) -> Just (prog, path, args ++ args')) 246 . updateConfiguredProgs 247 (flip Map.update name $ 248 \prog -> Just prog { programOverrideArgs = programOverrideArgs prog 249 ++ args' }) 250 251 252-- | Like 'userSpecifyPath' but for a list of progs and their paths. 253-- 254userSpecifyPaths :: [(String, FilePath)] 255 -> ProgramDb 256 -> ProgramDb 257userSpecifyPaths paths progdb = 258 foldl' (\progdb' (prog, path) -> userSpecifyPath prog path progdb') progdb paths 259 260 261-- | Like 'userSpecifyPath' but for a list of progs and their args. 262-- 263userSpecifyArgss :: [(String, [ProgArg])] 264 -> ProgramDb 265 -> ProgramDb 266userSpecifyArgss argss progdb = 267 foldl' (\progdb' (prog, args) -> userSpecifyArgs prog args progdb') progdb argss 268 269 270-- | Get the path that has been previously specified for a program, if any. 271-- 272userSpecifiedPath :: Program -> ProgramDb -> Maybe FilePath 273userSpecifiedPath prog = 274 join . fmap (\(_,p,_)->p) . Map.lookup (programName prog) . unconfiguredProgs 275 276 277-- | Get any extra args that have been previously specified for a program. 278-- 279userSpecifiedArgs :: Program -> ProgramDb -> [ProgArg] 280userSpecifiedArgs prog = 281 maybe [] (\(_,_,as)->as) . Map.lookup (programName prog) . unconfiguredProgs 282 283 284-- ----------------------------- 285-- Managing configured programs 286 287-- | Try to find a configured program 288lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram 289lookupProgram prog = Map.lookup (programName prog) . configuredProgs 290 291 292-- | Update a configured program in the database. 293updateProgram :: ConfiguredProgram -> ProgramDb 294 -> ProgramDb 295updateProgram prog = updateConfiguredProgs $ 296 Map.insert (programId prog) prog 297 298 299-- | List all configured programs. 300configuredPrograms :: ProgramDb -> [ConfiguredProgram] 301configuredPrograms = Map.elems . configuredProgs 302 303-- --------------------------- 304-- Configuring known programs 305 306-- | Try to configure a specific program. If the program is already included in 307-- the collection of unconfigured programs then we use any user-supplied 308-- location and arguments. If the program gets configured successfully it gets 309-- added to the configured collection. 310-- 311-- Note that it is not a failure if the program cannot be configured. It's only 312-- a failure if the user supplied a location and the program could not be found 313-- at that location. 314-- 315-- The reason for it not being a failure at this stage is that we don't know up 316-- front all the programs we will need, so we try to configure them all. 317-- To verify that a program was actually successfully configured use 318-- 'requireProgram'. 319-- 320configureProgram :: Verbosity 321 -> Program 322 -> ProgramDb 323 -> IO ProgramDb 324configureProgram verbosity prog progdb = do 325 let name = programName prog 326 maybeLocation <- case userSpecifiedPath prog progdb of 327 Nothing -> 328 programFindLocation prog verbosity (progSearchPath progdb) 329 >>= return . fmap (swap . fmap FoundOnSystem . swap) 330 Just path -> do 331 absolute <- doesExecutableExist path 332 if absolute 333 then return (Just (UserSpecified path, [])) 334 else findProgramOnSearchPath verbosity (progSearchPath progdb) path 335 >>= maybe (die' verbosity notFound) 336 (return . Just . swap . fmap UserSpecified . swap) 337 where notFound = "Cannot find the program '" ++ name 338 ++ "'. User-specified path '" 339 ++ path ++ "' does not refer to an executable and " 340 ++ "the program is not on the system path." 341 case maybeLocation of 342 Nothing -> return progdb 343 Just (location, triedLocations) -> do 344 version <- programFindVersion prog verbosity (locationPath location) 345 newPath <- programSearchPathAsPATHVar (progSearchPath progdb) 346 let configuredProg = ConfiguredProgram { 347 programId = name, 348 programVersion = version, 349 programDefaultArgs = [], 350 programOverrideArgs = userSpecifiedArgs prog progdb, 351 programOverrideEnv = [("PATH", Just newPath)], 352 programProperties = Map.empty, 353 programLocation = location, 354 programMonitorFiles = triedLocations 355 } 356 configuredProg' <- programPostConf prog verbosity configuredProg 357 return (updateConfiguredProgs (Map.insert name configuredProg') progdb) 358 359 360-- | Configure a bunch of programs using 'configureProgram'. Just a 'foldM'. 361-- 362configurePrograms :: Verbosity 363 -> [Program] 364 -> ProgramDb 365 -> IO ProgramDb 366configurePrograms verbosity progs progdb = 367 foldM (flip (configureProgram verbosity)) progdb progs 368 369 370-- | Unconfigure a program. This is basically a hack and you shouldn't 371-- use it, but it can be handy for making sure a 'requireProgram' 372-- actually reconfigures. 373unconfigureProgram :: String -> ProgramDb -> ProgramDb 374unconfigureProgram progname = 375 updateConfiguredProgs $ Map.delete progname 376 377-- | Try to configure all the known programs that have not yet been configured. 378-- 379configureAllKnownPrograms :: Verbosity 380 -> ProgramDb 381 -> IO ProgramDb 382configureAllKnownPrograms verbosity progdb = 383 configurePrograms verbosity 384 [ prog | (prog,_,_) <- Map.elems notYetConfigured ] progdb 385 where 386 notYetConfigured = unconfiguredProgs progdb 387 `Map.difference` configuredProgs progdb 388 389 390-- | reconfigure a bunch of programs given new user-specified args. It takes 391-- the same inputs as 'userSpecifyPath' and 'userSpecifyArgs' and for all progs 392-- with a new path it calls 'configureProgram'. 393-- 394reconfigurePrograms :: Verbosity 395 -> [(String, FilePath)] 396 -> [(String, [ProgArg])] 397 -> ProgramDb 398 -> IO ProgramDb 399reconfigurePrograms verbosity paths argss progdb = do 400 configurePrograms verbosity progs 401 . userSpecifyPaths paths 402 . userSpecifyArgss argss 403 $ progdb 404 405 where 406 progs = catMaybes [ lookupKnownProgram name progdb | (name,_) <- paths ] 407 408 409-- | Check that a program is configured and available to be run. 410-- 411-- It raises an exception if the program could not be configured, otherwise 412-- it returns the configured program. 413-- 414requireProgram :: Verbosity -> Program -> ProgramDb 415 -> IO (ConfiguredProgram, ProgramDb) 416requireProgram verbosity prog progdb = do 417 mres <- needProgram verbosity prog progdb 418 case mres of 419 Nothing -> die' verbosity notFound 420 Just res -> return res 421 where 422 notFound = "The program '" ++ programName prog ++ "' is required but it could not be found." 423 424-- | Check that a program is configured and available to be run. 425-- 426-- It returns 'Nothing' if the program couldn't be configured, 427-- or is not found. 428-- 429-- @since 3.0.1.0 430needProgram :: Verbosity -> Program -> ProgramDb 431 -> IO (Maybe (ConfiguredProgram, ProgramDb)) 432needProgram verbosity prog progdb = do 433 434 -- If it's not already been configured, try to configure it now 435 progdb' <- case lookupProgram prog progdb of 436 Nothing -> configureProgram verbosity prog progdb 437 Just _ -> return progdb 438 439 case lookupProgram prog progdb' of 440 Nothing -> return Nothing 441 Just configuredProg -> return (Just (configuredProg, progdb')) 442 443-- | Check that a program is configured and available to be run. 444-- 445-- Additionally check that the program version number is suitable and return 446-- it. For example you could require 'AnyVersion' or @'orLaterVersion' 447-- ('Version' [1,0] [])@ 448-- 449-- It returns the configured program, its version number and a possibly updated 450-- 'ProgramDb'. If the program could not be configured or the version is 451-- unsuitable, it returns an error value. 452-- 453lookupProgramVersion 454 :: Verbosity -> Program -> VersionRange -> ProgramDb 455 -> IO (Either String (ConfiguredProgram, Version, ProgramDb)) 456lookupProgramVersion verbosity prog range programDb = do 457 458 -- If it's not already been configured, try to configure it now 459 programDb' <- case lookupProgram prog programDb of 460 Nothing -> configureProgram verbosity prog programDb 461 Just _ -> return programDb 462 463 case lookupProgram prog programDb' of 464 Nothing -> return $! Left notFound 465 Just configuredProg@ConfiguredProgram { programLocation = location } -> 466 case programVersion configuredProg of 467 Just version 468 | withinRange version range -> 469 return $! Right (configuredProg, version ,programDb') 470 | otherwise -> 471 return $! Left (badVersion version location) 472 Nothing -> 473 return $! Left (unknownVersion location) 474 475 where notFound = "The program '" 476 ++ programName prog ++ "'" ++ versionRequirement 477 ++ " is required but it could not be found." 478 badVersion v l = "The program '" 479 ++ programName prog ++ "'" ++ versionRequirement 480 ++ " is required but the version found at " 481 ++ locationPath l ++ " is version " ++ prettyShow v 482 unknownVersion l = "The program '" 483 ++ programName prog ++ "'" ++ versionRequirement 484 ++ " is required but the version of " 485 ++ locationPath l ++ " could not be determined." 486 versionRequirement 487 | isAnyVersion range = "" 488 | otherwise = " version " ++ prettyShow range 489 490-- | Like 'lookupProgramVersion', but raises an exception in case of error 491-- instead of returning 'Left errMsg'. 492-- 493requireProgramVersion :: Verbosity -> Program -> VersionRange 494 -> ProgramDb 495 -> IO (ConfiguredProgram, Version, ProgramDb) 496requireProgramVersion verbosity prog range programDb = 497 join $ either (die' verbosity) return `fmap` 498 lookupProgramVersion verbosity prog range programDb 499