Cabal/src/Distribution/Simple/Program/Db.hs

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