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