{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Program.Db
-- Copyright   :  Isaac Jones 2006, Duncan Coutts 2007-2009
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This provides a 'ProgramDb' type which holds configured and not-yet
-- configured programs. It is the parameter to lots of actions elsewhere in
-- Cabal that need to look up and run programs. If we had a Cabal monad,
-- the 'ProgramDb' would probably be a reader or state component of it.
--
-- One nice thing about using it is that any program that is
-- registered with Cabal will get some \"configure\" and \".cabal\"
-- helpers like --with-foo-args --foo-path= and extra-foo-args.
--
-- There's also a hook for adding programs in a Setup.lhs script.  See
-- hookedPrograms in 'Distribution.Simple.UserHooks'.  This gives a
-- hook user the ability to get the above flags and such so that they
-- don't have to write all the PATH logic inside Setup.lhs.
module Distribution.Simple.Program.Db
  ( -- * The collection of configured programs we can run
    ProgramDb
  , emptyProgramDb
  , defaultProgramDb
  , restoreProgramDb

    -- ** Query and manipulate the program db
  , addKnownProgram
  , addKnownPrograms
  , prependProgramSearchPath
  , lookupKnownProgram
  , knownPrograms
  , getProgramSearchPath
  , setProgramSearchPath
  , modifyProgramSearchPath
  , userSpecifyPath
  , userSpecifyPaths
  , userMaybeSpecifyPath
  , userSpecifyArgs
  , userSpecifyArgss
  , userSpecifiedArgs
  , lookupProgram
  , lookupProgramByName
  , updateProgram
  , configuredPrograms

    -- ** Query and manipulate the program db
  , configureProgram
  , configureAllKnownPrograms
  , unconfigureProgram
  , lookupProgramVersion
  , reconfigurePrograms
  , requireProgram
  , requireProgramVersion
  , needProgram
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Simple.Program.Builtin
import Distribution.Simple.Program.Find
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
import Distribution.Utils.Structured (Structure (..), Structured (..))
import Distribution.Verbosity
import Distribution.Version

import Data.Tuple (swap)

import qualified Data.Map as Map
import Distribution.Simple.Errors

-- ------------------------------------------------------------

-- * Programs database

-- ------------------------------------------------------------

-- | The configuration is a collection of information about programs. It
-- contains information both about configured programs and also about programs
-- that we are yet to configure.
--
-- The idea is that we start from a collection of unconfigured programs and one
-- by one we try to configure them at which point we move them into the
-- configured collection. For unconfigured programs we record not just the
-- 'Program' but also any user-provided arguments and location for the program.
data ProgramDb = ProgramDb
  { ProgramDb -> UnconfiguredProgs
unconfiguredProgs :: UnconfiguredProgs
  , ProgramDb -> ProgramSearchPath
progSearchPath :: ProgramSearchPath
  , ProgramDb -> ConfiguredProgs
configuredProgs :: ConfiguredProgs
  }
  deriving (Typeable)

type UnconfiguredProgram = (Program, Maybe FilePath, [ProgArg])
type UnconfiguredProgs = Map.Map String UnconfiguredProgram
type ConfiguredProgs = Map.Map String ConfiguredProgram

emptyProgramDb :: ProgramDb
emptyProgramDb :: ProgramDb
emptyProgramDb = UnconfiguredProgs
-> ProgramSearchPath -> ConfiguredProgs -> ProgramDb
ProgramDb UnconfiguredProgs
forall k a. Map k a
Map.empty ProgramSearchPath
defaultProgramSearchPath ConfiguredProgs
forall k a. Map k a
Map.empty

defaultProgramDb :: ProgramDb
defaultProgramDb :: ProgramDb
defaultProgramDb = [Program] -> ProgramDb -> ProgramDb
restoreProgramDb [Program]
builtinPrograms ProgramDb
emptyProgramDb

-- internal helpers:
updateUnconfiguredProgs
  :: (UnconfiguredProgs -> UnconfiguredProgs)
  -> ProgramDb
  -> ProgramDb
updateUnconfiguredProgs :: (UnconfiguredProgs -> UnconfiguredProgs) -> ProgramDb -> ProgramDb
updateUnconfiguredProgs UnconfiguredProgs -> UnconfiguredProgs
update ProgramDb
progdb =
  ProgramDb
progdb{unconfiguredProgs = update (unconfiguredProgs progdb)}

updateConfiguredProgs
  :: (ConfiguredProgs -> ConfiguredProgs)
  -> ProgramDb
  -> ProgramDb
updateConfiguredProgs :: (ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb
updateConfiguredProgs ConfiguredProgs -> ConfiguredProgs
update ProgramDb
progdb =
  ProgramDb
progdb{configuredProgs = update (configuredProgs progdb)}

-- Read & Show instances are based on listToFM

-- | Note that this instance does not preserve the known 'Program's.
-- See 'restoreProgramDb' for details.
instance Show ProgramDb where
  show :: ProgramDb -> String
show = [(String, ConfiguredProgram)] -> String
forall a. Show a => a -> String
show ([(String, ConfiguredProgram)] -> String)
-> (ProgramDb -> [(String, ConfiguredProgram)])
-> ProgramDb
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredProgs -> [(String, ConfiguredProgram)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (ConfiguredProgs -> [(String, ConfiguredProgram)])
-> (ProgramDb -> ConfiguredProgs)
-> ProgramDb
-> [(String, ConfiguredProgram)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramDb -> ConfiguredProgs
configuredProgs

-- | Note that this instance does not preserve the known 'Program's.
-- See 'restoreProgramDb' for details.
instance Read ProgramDb where
  readsPrec :: Int -> ReadS ProgramDb
readsPrec Int
p String
s =
    [ (ProgramDb
emptyProgramDb{configuredProgs = Map.fromList s'}, String
r)
    | ([(String, ConfiguredProgram)]
s', String
r) <- Int -> ReadS [(String, ConfiguredProgram)]
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s
    ]

-- | Note that this instance does not preserve the known 'Program's.
-- See 'restoreProgramDb' for details.
instance Binary ProgramDb where
  put :: ProgramDb -> Put
put ProgramDb
db = do
    ProgramSearchPath -> Put
forall t. Binary t => t -> Put
put (ProgramDb -> ProgramSearchPath
progSearchPath ProgramDb
db)
    ConfiguredProgs -> Put
forall t. Binary t => t -> Put
put (ProgramDb -> ConfiguredProgs
configuredProgs ProgramDb
db)

  get :: Get ProgramDb
get = do
    ProgramSearchPath
searchpath <- Get ProgramSearchPath
forall t. Binary t => Get t
get
    ConfiguredProgs
progs <- Get ConfiguredProgs
forall t. Binary t => Get t
get
    ProgramDb -> Get ProgramDb
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramDb -> Get ProgramDb) -> ProgramDb -> Get ProgramDb
forall a b. (a -> b) -> a -> b
$!
      ProgramDb
emptyProgramDb
        { progSearchPath = searchpath
        , configuredProgs = progs
        }

instance Structured ProgramDb where
  structure :: Proxy ProgramDb -> Structure
structure Proxy ProgramDb
p =
    TypeRep -> TypeVersion -> String -> [Structure] -> Structure
Nominal
      (Proxy ProgramDb -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy ProgramDb
p)
      TypeVersion
0
      String
"ProgramDb"
      [ Proxy ProgramSearchPath -> Structure
forall a. Structured a => Proxy a -> Structure
structure (Proxy ProgramSearchPath
forall {k} (t :: k). Proxy t
Proxy :: Proxy ProgramSearchPath)
      , Proxy ConfiguredProgs -> Structure
forall a. Structured a => Proxy a -> Structure
structure (Proxy ConfiguredProgs
forall {k} (t :: k). Proxy t
Proxy :: Proxy ConfiguredProgs)
      ]

-- | The 'Read'\/'Show' and 'Binary' instances do not preserve all the
-- unconfigured 'Programs' because 'Program' is not in 'Read'\/'Show' because
-- it contains functions. So to fully restore a deserialised 'ProgramDb' use
-- this function to add back all the known 'Program's.
--
-- * It does not add the default programs, but you probably want them, use
--   'builtinPrograms' in addition to any extra you might need.
restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb
restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb
restoreProgramDb = [Program] -> ProgramDb -> ProgramDb
addKnownPrograms

-- -------------------------------
-- Managing unconfigured programs

-- | Add a known program that we may configure later
addKnownProgram :: Program -> ProgramDb -> ProgramDb
addKnownProgram :: Program -> ProgramDb -> ProgramDb
addKnownProgram Program
prog =
  (UnconfiguredProgs -> UnconfiguredProgs) -> ProgramDb -> ProgramDb
updateUnconfiguredProgs ((UnconfiguredProgs -> UnconfiguredProgs)
 -> ProgramDb -> ProgramDb)
-> (UnconfiguredProgs -> UnconfiguredProgs)
-> ProgramDb
-> ProgramDb
forall a b. (a -> b) -> a -> b
$
    (UnconfiguredProgram -> UnconfiguredProgram -> UnconfiguredProgram)
-> String
-> UnconfiguredProgram
-> UnconfiguredProgs
-> UnconfiguredProgs
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith UnconfiguredProgram -> UnconfiguredProgram -> UnconfiguredProgram
forall {p} {a} {b} {c}. p -> (a, b, c) -> (Program, b, c)
combine (Program -> String
programName Program
prog) (Program
prog, Maybe String
forall a. Maybe a
Nothing, [])
  where
    combine :: p -> (a, b, c) -> (Program, b, c)
combine p
_ (a
_, b
path, c
args) = (Program
prog, b
path, c
args)

addKnownPrograms :: [Program] -> ProgramDb -> ProgramDb
addKnownPrograms :: [Program] -> ProgramDb -> ProgramDb
addKnownPrograms [Program]
progs ProgramDb
progdb = (ProgramDb -> Program -> ProgramDb)
-> ProgramDb -> [Program] -> ProgramDb
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Program -> ProgramDb -> ProgramDb)
-> ProgramDb -> Program -> ProgramDb
forall a b c. (a -> b -> c) -> b -> a -> c
flip Program -> ProgramDb -> ProgramDb
addKnownProgram) ProgramDb
progdb [Program]
progs

lookupKnownProgram :: String -> ProgramDb -> Maybe Program
lookupKnownProgram :: String -> ProgramDb -> Maybe Program
lookupKnownProgram String
name =
  (UnconfiguredProgram -> Program)
-> Maybe UnconfiguredProgram -> Maybe Program
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Program
p, Maybe String
_, [String]
_) -> Program
p) (Maybe UnconfiguredProgram -> Maybe Program)
-> (ProgramDb -> Maybe UnconfiguredProgram)
-> ProgramDb
-> Maybe Program
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnconfiguredProgs -> Maybe UnconfiguredProgram
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name (UnconfiguredProgs -> Maybe UnconfiguredProgram)
-> (ProgramDb -> UnconfiguredProgs)
-> ProgramDb
-> Maybe UnconfiguredProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramDb -> UnconfiguredProgs
unconfiguredProgs

knownPrograms :: ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms :: ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms ProgramDb
progdb =
  [ (Program
p, Maybe ConfiguredProgram
p') | (Program
p, Maybe String
_, [String]
_) <- UnconfiguredProgs -> [UnconfiguredProgram]
forall k a. Map k a -> [a]
Map.elems (ProgramDb -> UnconfiguredProgs
unconfiguredProgs ProgramDb
progdb), let p' :: Maybe ConfiguredProgram
p' = String -> ConfiguredProgs -> Maybe ConfiguredProgram
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Program -> String
programName Program
p) (ProgramDb -> ConfiguredProgs
configuredProgs ProgramDb
progdb)
  ]

-- | Get the current 'ProgramSearchPath' used by the 'ProgramDb'.
-- This is the default list of locations where programs are looked for when
-- configuring them. This can be overridden for specific programs (with
-- 'userSpecifyPath'), and specific known programs can modify or ignore this
-- search path in their own configuration code.
getProgramSearchPath :: ProgramDb -> ProgramSearchPath
getProgramSearchPath :: ProgramDb -> ProgramSearchPath
getProgramSearchPath = ProgramDb -> ProgramSearchPath
progSearchPath

-- | Change the current 'ProgramSearchPath' used by the 'ProgramDb'.
-- This will affect programs that are configured from here on, so you
-- should usually set it before configuring any programs.
setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb
setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb
setProgramSearchPath ProgramSearchPath
searchpath ProgramDb
db = ProgramDb
db{progSearchPath = searchpath}

-- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'.
-- This will affect programs that are configured from here on, so you
-- should usually modify it before configuring any programs.
modifyProgramSearchPath
  :: (ProgramSearchPath -> ProgramSearchPath)
  -> ProgramDb
  -> ProgramDb
modifyProgramSearchPath :: (ProgramSearchPath -> ProgramSearchPath) -> ProgramDb -> ProgramDb
modifyProgramSearchPath ProgramSearchPath -> ProgramSearchPath
f ProgramDb
db =
  ProgramSearchPath -> ProgramDb -> ProgramDb
setProgramSearchPath (ProgramSearchPath -> ProgramSearchPath
f (ProgramSearchPath -> ProgramSearchPath)
-> ProgramSearchPath -> ProgramSearchPath
forall a b. (a -> b) -> a -> b
$ ProgramDb -> ProgramSearchPath
getProgramSearchPath ProgramDb
db) ProgramDb
db

-- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'
-- by prepending the provided extra paths. Also logs the added paths
-- in info verbosity.
prependProgramSearchPath
  :: Verbosity
  -> [FilePath]
  -> ProgramDb
  -> IO ProgramDb
prependProgramSearchPath :: Verbosity -> [String] -> ProgramDb -> IO ProgramDb
prependProgramSearchPath Verbosity
verbosity [String]
extraPaths ProgramDb
db =
  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
extraPaths
    then do
      Verbosity -> [String] -> IO ()
logExtraProgramSearchPath Verbosity
verbosity [String]
extraPaths
      ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgramDb -> IO ProgramDb) -> ProgramDb -> IO ProgramDb
forall a b. (a -> b) -> a -> b
$ (ProgramSearchPath -> ProgramSearchPath) -> ProgramDb -> ProgramDb
modifyProgramSearchPath ((String -> ProgramSearchPathEntry) -> [String] -> ProgramSearchPath
forall a b. (a -> b) -> [a] -> [b]
map String -> ProgramSearchPathEntry
ProgramSearchPathDir [String]
extraPaths ProgramSearchPath -> ProgramSearchPath -> ProgramSearchPath
forall a. [a] -> [a] -> [a]
++) ProgramDb
db
    else ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramDb
db

-- | User-specify this path.  Basically override any path information
--  for this program in the configuration. If it's not a known
--  program ignore it.
userSpecifyPath
  :: String
  -- ^ Program name
  -> FilePath
  -- ^ user-specified path to the program
  -> ProgramDb
  -> ProgramDb
userSpecifyPath :: String -> String -> ProgramDb -> ProgramDb
userSpecifyPath String
name String
path = (UnconfiguredProgs -> UnconfiguredProgs) -> ProgramDb -> ProgramDb
updateUnconfiguredProgs ((UnconfiguredProgs -> UnconfiguredProgs)
 -> ProgramDb -> ProgramDb)
-> (UnconfiguredProgs -> UnconfiguredProgs)
-> ProgramDb
-> ProgramDb
forall a b. (a -> b) -> a -> b
$
  ((UnconfiguredProgram -> Maybe UnconfiguredProgram)
 -> String -> UnconfiguredProgs -> UnconfiguredProgs)
-> String
-> (UnconfiguredProgram -> Maybe UnconfiguredProgram)
-> UnconfiguredProgs
-> UnconfiguredProgs
forall a b c. (a -> b -> c) -> b -> a -> c
flip (UnconfiguredProgram -> Maybe UnconfiguredProgram)
-> String -> UnconfiguredProgs -> UnconfiguredProgs
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update String
name ((UnconfiguredProgram -> Maybe UnconfiguredProgram)
 -> UnconfiguredProgs -> UnconfiguredProgs)
-> (UnconfiguredProgram -> Maybe UnconfiguredProgram)
-> UnconfiguredProgs
-> UnconfiguredProgs
forall a b. (a -> b) -> a -> b
$
    \(Program
prog, Maybe String
_, [String]
args) -> UnconfiguredProgram -> Maybe UnconfiguredProgram
forall a. a -> Maybe a
Just (Program
prog, String -> Maybe String
forall a. a -> Maybe a
Just String
path, [String]
args)

userMaybeSpecifyPath
  :: String
  -> Maybe FilePath
  -> ProgramDb
  -> ProgramDb
userMaybeSpecifyPath :: String -> Maybe String -> ProgramDb -> ProgramDb
userMaybeSpecifyPath String
_ Maybe String
Nothing ProgramDb
progdb = ProgramDb
progdb
userMaybeSpecifyPath String
name (Just String
path) ProgramDb
progdb = String -> String -> ProgramDb -> ProgramDb
userSpecifyPath String
name String
path ProgramDb
progdb

-- | User-specify the arguments for this program.  Basically override
--  any args information for this program in the configuration. If it's
--  not a known program, ignore it..
userSpecifyArgs
  :: String
  -- ^ Program name
  -> [ProgArg]
  -- ^ user-specified args
  -> ProgramDb
  -> ProgramDb
userSpecifyArgs :: String -> [String] -> ProgramDb -> ProgramDb
userSpecifyArgs String
name [String]
args' =
  (UnconfiguredProgs -> UnconfiguredProgs) -> ProgramDb -> ProgramDb
updateUnconfiguredProgs
    ( ((UnconfiguredProgram -> Maybe UnconfiguredProgram)
 -> String -> UnconfiguredProgs -> UnconfiguredProgs)
-> String
-> (UnconfiguredProgram -> Maybe UnconfiguredProgram)
-> UnconfiguredProgs
-> UnconfiguredProgs
forall a b c. (a -> b -> c) -> b -> a -> c
flip (UnconfiguredProgram -> Maybe UnconfiguredProgram)
-> String -> UnconfiguredProgs -> UnconfiguredProgs
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update String
name ((UnconfiguredProgram -> Maybe UnconfiguredProgram)
 -> UnconfiguredProgs -> UnconfiguredProgs)
-> (UnconfiguredProgram -> Maybe UnconfiguredProgram)
-> UnconfiguredProgs
-> UnconfiguredProgs
forall a b. (a -> b) -> a -> b
$
        \(Program
prog, Maybe String
path, [String]
args) -> UnconfiguredProgram -> Maybe UnconfiguredProgram
forall a. a -> Maybe a
Just (Program
prog, Maybe String
path, [String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args')
    )
    (ProgramDb -> ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb
updateConfiguredProgs
      ( ((ConfiguredProgram -> Maybe ConfiguredProgram)
 -> String -> ConfiguredProgs -> ConfiguredProgs)
-> String
-> (ConfiguredProgram -> Maybe ConfiguredProgram)
-> ConfiguredProgs
-> ConfiguredProgs
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ConfiguredProgram -> Maybe ConfiguredProgram)
-> String -> ConfiguredProgs -> ConfiguredProgs
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update String
name ((ConfiguredProgram -> Maybe ConfiguredProgram)
 -> ConfiguredProgs -> ConfiguredProgs)
-> (ConfiguredProgram -> Maybe ConfiguredProgram)
-> ConfiguredProgs
-> ConfiguredProgs
forall a b. (a -> b) -> a -> b
$
          \ConfiguredProgram
prog ->
            ConfiguredProgram -> Maybe ConfiguredProgram
forall a. a -> Maybe a
Just
              ConfiguredProgram
prog
                { programOverrideArgs =
                    programOverrideArgs prog
                      ++ args'
                }
      )

-- | Like 'userSpecifyPath' but for a list of progs and their paths.
userSpecifyPaths
  :: [(String, FilePath)]
  -> ProgramDb
  -> ProgramDb
userSpecifyPaths :: [(String, String)] -> ProgramDb -> ProgramDb
userSpecifyPaths [(String, String)]
paths ProgramDb
progdb =
  (ProgramDb -> (String, String) -> ProgramDb)
-> ProgramDb -> [(String, String)] -> ProgramDb
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ProgramDb
progdb' (String
prog, String
path) -> String -> String -> ProgramDb -> ProgramDb
userSpecifyPath String
prog String
path ProgramDb
progdb') ProgramDb
progdb [(String, String)]
paths

-- | Like 'userSpecifyPath' but for a list of progs and their args.
userSpecifyArgss
  :: [(String, [ProgArg])]
  -> ProgramDb
  -> ProgramDb
userSpecifyArgss :: [(String, [String])] -> ProgramDb -> ProgramDb
userSpecifyArgss [(String, [String])]
argss ProgramDb
progdb =
  (ProgramDb -> (String, [String]) -> ProgramDb)
-> ProgramDb -> [(String, [String])] -> ProgramDb
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ProgramDb
progdb' (String
prog, [String]
args) -> String -> [String] -> ProgramDb -> ProgramDb
userSpecifyArgs String
prog [String]
args ProgramDb
progdb') ProgramDb
progdb [(String, [String])]
argss

-- | Get the path that has been previously specified for a program, if any.
userSpecifiedPath :: Program -> ProgramDb -> Maybe FilePath
userSpecifiedPath :: Program -> ProgramDb -> Maybe String
userSpecifiedPath Program
prog =
  Maybe (Maybe String) -> Maybe String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe String) -> Maybe String)
-> (ProgramDb -> Maybe (Maybe String)) -> ProgramDb -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnconfiguredProgram -> Maybe String)
-> Maybe UnconfiguredProgram -> Maybe (Maybe String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Program
_, Maybe String
p, [String]
_) -> Maybe String
p) (Maybe UnconfiguredProgram -> Maybe (Maybe String))
-> (ProgramDb -> Maybe UnconfiguredProgram)
-> ProgramDb
-> Maybe (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnconfiguredProgs -> Maybe UnconfiguredProgram
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Program -> String
programName Program
prog) (UnconfiguredProgs -> Maybe UnconfiguredProgram)
-> (ProgramDb -> UnconfiguredProgs)
-> ProgramDb
-> Maybe UnconfiguredProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramDb -> UnconfiguredProgs
unconfiguredProgs

-- | Get any extra args that have been previously specified for a program.
userSpecifiedArgs :: Program -> ProgramDb -> [ProgArg]
userSpecifiedArgs :: Program -> ProgramDb -> [String]
userSpecifiedArgs Program
prog =
  [String]
-> (UnconfiguredProgram -> [String])
-> Maybe UnconfiguredProgram
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(Program
_, Maybe String
_, [String]
as) -> [String]
as) (Maybe UnconfiguredProgram -> [String])
-> (ProgramDb -> Maybe UnconfiguredProgram)
-> ProgramDb
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnconfiguredProgs -> Maybe UnconfiguredProgram
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Program -> String
programName Program
prog) (UnconfiguredProgs -> Maybe UnconfiguredProgram)
-> (ProgramDb -> UnconfiguredProgs)
-> ProgramDb
-> Maybe UnconfiguredProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramDb -> UnconfiguredProgs
unconfiguredProgs

-- -----------------------------
-- Managing configured programs

-- | Try to find a configured program
lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram = String -> ProgramDb -> Maybe ConfiguredProgram
lookupProgramByName (String -> ProgramDb -> Maybe ConfiguredProgram)
-> (Program -> String)
-> Program
-> ProgramDb
-> Maybe ConfiguredProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
programName

-- | Try to find a configured program
lookupProgramByName :: String -> ProgramDb -> Maybe ConfiguredProgram
lookupProgramByName :: String -> ProgramDb -> Maybe ConfiguredProgram
lookupProgramByName String
name = String -> ConfiguredProgs -> Maybe ConfiguredProgram
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name (ConfiguredProgs -> Maybe ConfiguredProgram)
-> (ProgramDb -> ConfiguredProgs)
-> ProgramDb
-> Maybe ConfiguredProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramDb -> ConfiguredProgs
configuredProgs

-- | Update a configured program in the database.
updateProgram
  :: ConfiguredProgram
  -> ProgramDb
  -> ProgramDb
updateProgram :: ConfiguredProgram -> ProgramDb -> ProgramDb
updateProgram ConfiguredProgram
prog =
  (ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb
updateConfiguredProgs ((ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb)
-> (ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
    String -> ConfiguredProgram -> ConfiguredProgs -> ConfiguredProgs
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ConfiguredProgram -> String
programId ConfiguredProgram
prog) ConfiguredProgram
prog

-- | List all configured programs.
configuredPrograms :: ProgramDb -> [ConfiguredProgram]
configuredPrograms :: ProgramDb -> [ConfiguredProgram]
configuredPrograms = ConfiguredProgs -> [ConfiguredProgram]
forall k a. Map k a -> [a]
Map.elems (ConfiguredProgs -> [ConfiguredProgram])
-> (ProgramDb -> ConfiguredProgs)
-> ProgramDb
-> [ConfiguredProgram]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramDb -> ConfiguredProgs
configuredProgs

-- ---------------------------
-- Configuring known programs

-- | Try to configure a specific program. If the program is already included in
-- the collection of unconfigured programs then we use any user-supplied
-- location and arguments. If the program gets configured successfully it gets
-- added to the configured collection.
--
-- Note that it is not a failure if the program cannot be configured. It's only
-- a failure if the user supplied a location and the program could not be found
-- at that location.
--
-- The reason for it not being a failure at this stage is that we don't know up
-- front all the programs we will need, so we try to configure them all.
-- To verify that a program was actually successfully configured use
-- 'requireProgram'.
configureProgram
  :: Verbosity
  -> Program
  -> ProgramDb
  -> IO ProgramDb
configureProgram :: Verbosity -> Program -> ProgramDb -> IO ProgramDb
configureProgram Verbosity
verbosity Program
prog ProgramDb
progdb = do
  let name :: String
name = Program -> String
programName Program
prog
  Maybe (ProgramLocation, [String])
maybeLocation <- case Program -> ProgramDb -> Maybe String
userSpecifiedPath Program
prog ProgramDb
progdb of
    Maybe String
Nothing ->
      Program
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation Program
prog Verbosity
verbosity (ProgramDb -> ProgramSearchPath
progSearchPath ProgramDb
progdb)
        IO (Maybe (String, [String]))
-> (Maybe (String, [String])
    -> IO (Maybe (ProgramLocation, [String])))
-> IO (Maybe (ProgramLocation, [String]))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (ProgramLocation, [String])
-> IO (Maybe (ProgramLocation, [String]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ProgramLocation, [String])
 -> IO (Maybe (ProgramLocation, [String])))
-> (Maybe (String, [String]) -> Maybe (ProgramLocation, [String]))
-> Maybe (String, [String])
-> IO (Maybe (ProgramLocation, [String]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [String]) -> (ProgramLocation, [String]))
-> Maybe (String, [String]) -> Maybe (ProgramLocation, [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String], ProgramLocation) -> (ProgramLocation, [String])
forall a b. (a, b) -> (b, a)
swap (([String], ProgramLocation) -> (ProgramLocation, [String]))
-> ((String, [String]) -> ([String], ProgramLocation))
-> (String, [String])
-> (ProgramLocation, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ProgramLocation)
-> ([String], String) -> ([String], ProgramLocation)
forall a b. (a -> b) -> ([String], a) -> ([String], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ProgramLocation
FoundOnSystem (([String], String) -> ([String], ProgramLocation))
-> ((String, [String]) -> ([String], String))
-> (String, [String])
-> ([String], ProgramLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> ([String], String)
forall a b. (a, b) -> (b, a)
swap)
    Just String
path -> do
      Bool
absolute <- String -> IO Bool
doesExecutableExist String
path
      if Bool
absolute
        then Maybe (ProgramLocation, [String])
-> IO (Maybe (ProgramLocation, [String]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ProgramLocation, [String]) -> Maybe (ProgramLocation, [String])
forall a. a -> Maybe a
Just (String -> ProgramLocation
UserSpecified String
path, []))
        else
          Verbosity
-> ProgramSearchPath -> String -> IO (Maybe (String, [String]))
findProgramOnSearchPath Verbosity
verbosity (ProgramDb -> ProgramSearchPath
progSearchPath ProgramDb
progdb) String
path
            IO (Maybe (String, [String]))
-> (Maybe (String, [String])
    -> IO (Maybe (ProgramLocation, [String])))
-> IO (Maybe (ProgramLocation, [String]))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe (ProgramLocation, [String]))
-> ((String, [String]) -> IO (Maybe (ProgramLocation, [String])))
-> Maybe (String, [String])
-> IO (Maybe (ProgramLocation, [String]))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              (Verbosity
-> CabalException -> IO (Maybe (ProgramLocation, [String]))
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO (Maybe (ProgramLocation, [String])))
-> CabalException -> IO (Maybe (ProgramLocation, [String]))
forall a b. (a -> b) -> a -> b
$ String -> String -> CabalException
ConfigureProgram String
name String
path)
              (Maybe (ProgramLocation, [String])
-> IO (Maybe (ProgramLocation, [String]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ProgramLocation, [String])
 -> IO (Maybe (ProgramLocation, [String])))
-> ((String, [String]) -> Maybe (ProgramLocation, [String]))
-> (String, [String])
-> IO (Maybe (ProgramLocation, [String]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgramLocation, [String]) -> Maybe (ProgramLocation, [String])
forall a. a -> Maybe a
Just ((ProgramLocation, [String]) -> Maybe (ProgramLocation, [String]))
-> ((String, [String]) -> (ProgramLocation, [String]))
-> (String, [String])
-> Maybe (ProgramLocation, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], ProgramLocation) -> (ProgramLocation, [String])
forall a b. (a, b) -> (b, a)
swap (([String], ProgramLocation) -> (ProgramLocation, [String]))
-> ((String, [String]) -> ([String], ProgramLocation))
-> (String, [String])
-> (ProgramLocation, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ProgramLocation)
-> ([String], String) -> ([String], ProgramLocation)
forall a b. (a -> b) -> ([String], a) -> ([String], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ProgramLocation
UserSpecified (([String], String) -> ([String], ProgramLocation))
-> ((String, [String]) -> ([String], String))
-> (String, [String])
-> ([String], ProgramLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> ([String], String)
forall a b. (a, b) -> (b, a)
swap)
  case Maybe (ProgramLocation, [String])
maybeLocation of
    Maybe (ProgramLocation, [String])
Nothing -> ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramDb
progdb
    Just (ProgramLocation
location, [String]
triedLocations) -> do
      Maybe Version
version <- Program -> Verbosity -> String -> IO (Maybe Version)
programFindVersion Program
prog Verbosity
verbosity (ProgramLocation -> String
locationPath ProgramLocation
location)
      String
newPath <- ProgramSearchPath -> IO String
programSearchPathAsPATHVar (ProgramDb -> ProgramSearchPath
progSearchPath ProgramDb
progdb)
      let configuredProg :: ConfiguredProgram
configuredProg =
            ConfiguredProgram
              { programId :: String
programId = String
name
              , programVersion :: Maybe Version
programVersion = Maybe Version
version
              , programDefaultArgs :: [String]
programDefaultArgs = []
              , programOverrideArgs :: [String]
programOverrideArgs = Program -> ProgramDb -> [String]
userSpecifiedArgs Program
prog ProgramDb
progdb
              , programOverrideEnv :: [(String, Maybe String)]
programOverrideEnv = [(String
"PATH", String -> Maybe String
forall a. a -> Maybe a
Just String
newPath)]
              , programProperties :: Map String String
programProperties = Map String String
forall k a. Map k a
Map.empty
              , programLocation :: ProgramLocation
programLocation = ProgramLocation
location
              , programMonitorFiles :: [String]
programMonitorFiles = [String]
triedLocations
              }
      ConfiguredProgram
configuredProg' <- Program -> Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
programPostConf Program
prog Verbosity
verbosity ConfiguredProgram
configuredProg
      ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb
updateConfiguredProgs (String -> ConfiguredProgram -> ConfiguredProgs -> ConfiguredProgs
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name ConfiguredProgram
configuredProg') ProgramDb
progdb)

-- | Configure a bunch of programs using 'configureProgram'. Just a 'foldM'.
configurePrograms
  :: Verbosity
  -> [Program]
  -> ProgramDb
  -> IO ProgramDb
configurePrograms :: Verbosity -> [Program] -> ProgramDb -> IO ProgramDb
configurePrograms Verbosity
verbosity [Program]
progs ProgramDb
progdb =
  (ProgramDb -> Program -> IO ProgramDb)
-> ProgramDb -> [Program] -> IO ProgramDb
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((Program -> ProgramDb -> IO ProgramDb)
-> ProgramDb -> Program -> IO ProgramDb
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Verbosity -> Program -> ProgramDb -> IO ProgramDb
configureProgram Verbosity
verbosity)) ProgramDb
progdb [Program]
progs

-- | Unconfigure a program.  This is basically a hack and you shouldn't
-- use it, but it can be handy for making sure a 'requireProgram'
-- actually reconfigures.
unconfigureProgram :: String -> ProgramDb -> ProgramDb
unconfigureProgram :: String -> ProgramDb -> ProgramDb
unconfigureProgram String
progname =
  (ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb
updateConfiguredProgs ((ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb)
-> (ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$ String -> ConfiguredProgs -> ConfiguredProgs
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete String
progname

-- | Try to configure all the known programs that have not yet been configured.
configureAllKnownPrograms
  :: Verbosity
  -> ProgramDb
  -> IO ProgramDb
configureAllKnownPrograms :: Verbosity -> ProgramDb -> IO ProgramDb
configureAllKnownPrograms Verbosity
verbosity ProgramDb
progdb =
  Verbosity -> [Program] -> ProgramDb -> IO ProgramDb
configurePrograms
    Verbosity
verbosity
    [Program
prog | (Program
prog, Maybe String
_, [String]
_) <- UnconfiguredProgs -> [UnconfiguredProgram]
forall k a. Map k a -> [a]
Map.elems UnconfiguredProgs
notYetConfigured]
    ProgramDb
progdb
  where
    notYetConfigured :: UnconfiguredProgs
notYetConfigured =
      ProgramDb -> UnconfiguredProgs
unconfiguredProgs ProgramDb
progdb
        UnconfiguredProgs -> ConfiguredProgs -> UnconfiguredProgs
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` ProgramDb -> ConfiguredProgs
configuredProgs ProgramDb
progdb

-- | reconfigure a bunch of programs given new user-specified args. It takes
-- the same inputs as 'userSpecifyPath' and 'userSpecifyArgs' and for all progs
-- with a new path it calls 'configureProgram'.
reconfigurePrograms
  :: Verbosity
  -> [(String, FilePath)]
  -> [(String, [ProgArg])]
  -> ProgramDb
  -> IO ProgramDb
reconfigurePrograms :: Verbosity
-> [(String, String)]
-> [(String, [String])]
-> ProgramDb
-> IO ProgramDb
reconfigurePrograms Verbosity
verbosity [(String, String)]
paths [(String, [String])]
argss ProgramDb
progdb = do
  Verbosity -> [Program] -> ProgramDb -> IO ProgramDb
configurePrograms Verbosity
verbosity [Program]
progs
    (ProgramDb -> IO ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> IO ProgramDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> ProgramDb -> ProgramDb
userSpecifyPaths [(String, String)]
paths
    (ProgramDb -> ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, [String])] -> ProgramDb -> ProgramDb
userSpecifyArgss [(String, [String])]
argss
    (ProgramDb -> IO ProgramDb) -> ProgramDb -> IO ProgramDb
forall a b. (a -> b) -> a -> b
$ ProgramDb
progdb
  where
    progs :: [Program]
progs = [Maybe Program] -> [Program]
forall a. [Maybe a] -> [a]
catMaybes [String -> ProgramDb -> Maybe Program
lookupKnownProgram String
name ProgramDb
progdb | (String
name, String
_) <- [(String, String)]
paths]

-- | Check that a program is configured and available to be run.
--
-- It raises an exception if the program could not be configured, otherwise
-- it returns the configured program.
requireProgram
  :: Verbosity
  -> Program
  -> ProgramDb
  -> IO (ConfiguredProgram, ProgramDb)
requireProgram :: Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
prog ProgramDb
progdb = do
  Maybe (ConfiguredProgram, ProgramDb)
mres <- Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
prog ProgramDb
progdb
  case Maybe (ConfiguredProgram, ProgramDb)
mres of
    Maybe (ConfiguredProgram, ProgramDb)
Nothing -> Verbosity -> CabalException -> IO (ConfiguredProgram, ProgramDb)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO (ConfiguredProgram, ProgramDb))
-> CabalException -> IO (ConfiguredProgram, ProgramDb)
forall a b. (a -> b) -> a -> b
$ String -> CabalException
RequireProgram (Program -> String
programName Program
prog)
    Just (ConfiguredProgram, ProgramDb)
res -> (ConfiguredProgram, ProgramDb) -> IO (ConfiguredProgram, ProgramDb)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfiguredProgram, ProgramDb)
res

-- | Check that a program is configured and available to be run.
--
-- It returns 'Nothing' if the program couldn't be configured,
-- or is not found.
--
-- @since 3.0.1.0
needProgram
  :: Verbosity
  -> Program
  -> ProgramDb
  -> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram :: Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
prog ProgramDb
progdb = do
  -- If it's not already been configured, try to configure it now
  ProgramDb
progdb' <- case Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
progdb of
    Maybe ConfiguredProgram
Nothing -> Verbosity -> Program -> ProgramDb -> IO ProgramDb
configureProgram Verbosity
verbosity Program
prog ProgramDb
progdb
    Just ConfiguredProgram
_ -> ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramDb
progdb

  case Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
progdb' of
    Maybe ConfiguredProgram
Nothing -> Maybe (ConfiguredProgram, ProgramDb)
-> IO (Maybe (ConfiguredProgram, ProgramDb))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ConfiguredProgram, ProgramDb)
forall a. Maybe a
Nothing
    Just ConfiguredProgram
configuredProg -> Maybe (ConfiguredProgram, ProgramDb)
-> IO (Maybe (ConfiguredProgram, ProgramDb))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ConfiguredProgram, ProgramDb)
-> Maybe (ConfiguredProgram, ProgramDb)
forall a. a -> Maybe a
Just (ConfiguredProgram
configuredProg, ProgramDb
progdb'))

-- | Check that a program is configured and available to be run.
--
-- Additionally check that the program version number is suitable and return
-- it. For example you could require 'AnyVersion' or @'orLaterVersion'
-- ('Version' [1,0] [])@
--
-- It returns the configured program, its version number and a possibly updated
-- 'ProgramDb'. If the program could not be configured or the version is
-- unsuitable, it returns an error value.
lookupProgramVersion
  :: Verbosity
  -> Program
  -> VersionRange
  -> ProgramDb
  -> IO (Either CabalException (ConfiguredProgram, Version, ProgramDb))
lookupProgramVersion :: Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
lookupProgramVersion Verbosity
verbosity Program
prog VersionRange
range ProgramDb
programDb = do
  -- If it's not already been configured, try to configure it now
  ProgramDb
programDb' <- case Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
programDb of
    Maybe ConfiguredProgram
Nothing -> Verbosity -> Program -> ProgramDb -> IO ProgramDb
configureProgram Verbosity
verbosity Program
prog ProgramDb
programDb
    Just ConfiguredProgram
_ -> ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramDb
programDb

  case Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
programDb' of
    Maybe ConfiguredProgram
Nothing -> Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CabalException (ConfiguredProgram, Version, ProgramDb)
 -> IO
      (Either CabalException (ConfiguredProgram, Version, ProgramDb)))
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
forall a b. (a -> b) -> a -> b
$! CabalException
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
forall a b. a -> Either a b
Left (CabalException
 -> Either CabalException (ConfiguredProgram, Version, ProgramDb))
-> CabalException
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
forall a b. (a -> b) -> a -> b
$ String -> VersionRange -> CabalException
NoProgramFound (Program -> String
programName Program
prog) VersionRange
range
    Just configuredProg :: ConfiguredProgram
configuredProg@ConfiguredProgram{programLocation :: ConfiguredProgram -> ProgramLocation
programLocation = ProgramLocation
location} ->
      case ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
configuredProg of
        Just Version
version
          | Version -> VersionRange -> Bool
withinRange Version
version VersionRange
range ->
              Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CabalException (ConfiguredProgram, Version, ProgramDb)
 -> IO
      (Either CabalException (ConfiguredProgram, Version, ProgramDb)))
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
forall a b. (a -> b) -> a -> b
$! (ConfiguredProgram, Version, ProgramDb)
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
forall a b. b -> Either a b
Right (ConfiguredProgram
configuredProg, Version
version, ProgramDb
programDb')
          | Bool
otherwise ->
              Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CabalException (ConfiguredProgram, Version, ProgramDb)
 -> IO
      (Either CabalException (ConfiguredProgram, Version, ProgramDb)))
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
forall a b. (a -> b) -> a -> b
$! CabalException
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
forall a b. a -> Either a b
Left (CabalException
 -> Either CabalException (ConfiguredProgram, Version, ProgramDb))
-> CabalException
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
forall a b. (a -> b) -> a -> b
$ String -> Version -> VersionRange -> String -> CabalException
BadVersionDb (Program -> String
programName Program
prog) Version
version VersionRange
range (ProgramLocation -> String
locationPath ProgramLocation
location)
        Maybe Version
Nothing ->
          Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CabalException (ConfiguredProgram, Version, ProgramDb)
 -> IO
      (Either CabalException (ConfiguredProgram, Version, ProgramDb)))
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
forall a b. (a -> b) -> a -> b
$! CabalException
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
forall a b. a -> Either a b
Left (CabalException
 -> Either CabalException (ConfiguredProgram, Version, ProgramDb))
-> CabalException
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
forall a b. (a -> b) -> a -> b
$ String -> VersionRange -> String -> CabalException
UnknownVersionDb (Program -> String
programName Program
prog) VersionRange
range (ProgramLocation -> String
locationPath ProgramLocation
location)

-- | Like 'lookupProgramVersion', but raises an exception in case of error
-- instead of returning 'Left errMsg'.
requireProgramVersion
  :: Verbosity
  -> Program
  -> VersionRange
  -> ProgramDb
  -> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion :: Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
prog VersionRange
range ProgramDb
programDb =
  IO (IO (ConfiguredProgram, Version, ProgramDb))
-> IO (ConfiguredProgram, Version, ProgramDb)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO (ConfiguredProgram, Version, ProgramDb))
 -> IO (ConfiguredProgram, Version, ProgramDb))
-> IO (IO (ConfiguredProgram, Version, ProgramDb))
-> IO (ConfiguredProgram, Version, ProgramDb)
forall a b. (a -> b) -> a -> b
$
    (CabalException -> IO (ConfiguredProgram, Version, ProgramDb))
-> ((ConfiguredProgram, Version, ProgramDb)
    -> IO (ConfiguredProgram, Version, ProgramDb))
-> Either CabalException (ConfiguredProgram, Version, ProgramDb)
-> IO (ConfiguredProgram, Version, ProgramDb)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity
-> CabalException -> IO (ConfiguredProgram, Version, ProgramDb)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity) (ConfiguredProgram, Version, ProgramDb)
-> IO (ConfiguredProgram, Version, ProgramDb)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      (Either CabalException (ConfiguredProgram, Version, ProgramDb)
 -> IO (ConfiguredProgram, Version, ProgramDb))
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
-> IO (IO (ConfiguredProgram, Version, ProgramDb))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO
     (Either CabalException (ConfiguredProgram, Version, ProgramDb))
lookupProgramVersion Verbosity
verbosity Program
prog VersionRange
range ProgramDb
programDb