{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.Program.Db
(
ProgramDb
, emptyProgramDb
, defaultProgramDb
, restoreProgramDb
, addKnownProgram
, addKnownPrograms
, prependProgramSearchPath
, lookupKnownProgram
, knownPrograms
, getProgramSearchPath
, setProgramSearchPath
, modifyProgramSearchPath
, userSpecifyPath
, userSpecifyPaths
, userMaybeSpecifyPath
, userSpecifyArgs
, userSpecifyArgss
, userSpecifiedArgs
, lookupProgram
, lookupProgramByName
, updateProgram
, configuredPrograms
, 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
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
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)}
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
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
]
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
searchpath <- Get ProgramSearchPath
forall t. Binary t => Get t
get
progs <- get
return $!
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)
]
restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb
restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb
restoreProgramDb = [Program] -> ProgramDb -> ProgramDb
addKnownPrograms
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)
]
getProgramSearchPath :: ProgramDb -> ProgramSearchPath
getProgramSearchPath :: ProgramDb -> ProgramSearchPath
getProgramSearchPath = ProgramDb -> ProgramSearchPath
progSearchPath
setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb
setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb
setProgramSearchPath ProgramSearchPath
searchpath ProgramDb
db = ProgramDb
db{progSearchPath = searchpath}
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
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
userSpecifyPath
:: String
-> FilePath
-> 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
userSpecifyArgs
:: String
-> [ProgArg]
-> 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'
}
)
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
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
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
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
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
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
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
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
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
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
absolute <- String -> IO Bool
doesExecutableExist String
path
if absolute
then return (Just (UserSpecified path, []))
else
findProgramOnSearchPath verbosity (progSearchPath progdb) path
>>= maybe
(dieWithException verbosity $ ConfigureProgram name path)
(return . Just . swap . fmap UserSpecified . swap)
case 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
version <- Program -> Verbosity -> String -> IO (Maybe Version)
programFindVersion Program
prog Verbosity
verbosity (ProgramLocation -> String
locationPath ProgramLocation
location)
newPath <- programSearchPathAsPATHVar (progSearchPath progdb)
let 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
}
configuredProg' <- programPostConf prog verbosity configuredProg
return (updateConfiguredProgs (Map.insert name configuredProg') progdb)
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
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
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
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]
requireProgram
:: Verbosity
-> Program
-> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)
requireProgram :: Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
prog ProgramDb
progdb = do
mres <- Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
prog ProgramDb
progdb
case 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
needProgram
:: Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram :: Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
prog ProgramDb
progdb = do
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 lookupProgram prog 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'))
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
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 lookupProgram prog 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)
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