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