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