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