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