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