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