module Distribution.Simple.Program.Db (
ProgramDb,
emptyProgramDb,
defaultProgramDb,
restoreProgramDb,
addKnownProgram,
addKnownPrograms,
lookupKnownProgram,
knownPrograms,
userSpecifyPath,
userSpecifyPaths,
userMaybeSpecifyPath,
userSpecifyArgs,
userSpecifyArgss,
userSpecifiedArgs,
lookupProgram,
updateProgram,
configureProgram,
configureAllKnownPrograms,
reconfigurePrograms,
requireProgram,
requireProgramVersion,
) where
import Distribution.Simple.Program.Types
( Program(..), ProgArg, ConfiguredProgram(..), ProgramLocation(..) )
import Distribution.Simple.Program.Builtin
( builtinPrograms )
import Distribution.Simple.Utils
( die, findProgramLocation )
import Distribution.Version
( Version, VersionRange, isAnyVersion, withinRange )
import Distribution.Text
( display )
import Distribution.Verbosity
( Verbosity )
import Data.List
( foldl' )
import Data.Maybe
( catMaybes )
import qualified Data.Map as Map
import Control.Monad
( join, foldM )
import System.Directory
( doesFileExist )
data unconfiguredProgs :: UnconfiguredProgsProgramDb = ProgramDb {
unconfiguredProgs :: UnconfiguredProgs,
configuredProgs :: ConfiguredProgs
}
type UnconfiguredProgram = (Program, Maybe FilePath, [ProgArg])
type UnconfiguredProgs = Map.Map String UnconfiguredProgram
type ConfiguredProgs = Map.Map String ConfiguredProgram
emptyProgramDb :: ProgramDb
emptyProgramDb = ProgramDb :: UnconfiguredProgs -> ConfiguredProgs -> ProgramDbProgramDb empty :: Map k aMap.empty empty :: Map k aMap.empty
defaultProgramDb :: ProgramDb
defaultProgramDb = restoreProgramDb :: [Program] -> ProgramDb -> ProgramDbrestoreProgramDb builtinPrograms :: [Program]builtinPrograms emptyProgramDb :: ProgramDbemptyProgramDb
updateUnconfiguredProgs :: (UnconfiguredProgs -> UnconfiguredProgs)
-> ProgramDb -> ProgramDb
updateUnconfiguredProgs update conf =
conf :: ProgramDbconf { unconfiguredProgs = update :: UnconfiguredProgs -> UnconfiguredProgsupdate (unconfiguredProgs :: ProgramDb -> UnconfiguredProgsunconfiguredProgs conf :: ProgramDbconf) }
updateConfiguredProgs :: (ConfiguredProgs -> ConfiguredProgs)
-> ProgramDb -> ProgramDb
updateConfiguredProgs update conf =
conf :: ProgramDbconf { configuredProgs = update :: UnconfiguredProgs -> UnconfiguredProgsupdate (configuredProgs :: ProgramDb -> ConfiguredProgsconfiguredProgs conf :: ProgramDbconf) }
instance D:Show ::
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow ProgramDb where
show = show :: Show a => a -> Stringshow (.) :: (b -> c) -> (a -> b) -> a -> c. toAscList :: Map k a -> [(k, a)]Map.toAscList (.) :: (b -> c) -> (a -> b) -> a -> c. configuredProgs :: ProgramDb -> ConfiguredProgsconfiguredProgs
instance D:Read ::
(Int -> ReadS a)
-> ReadS [a]
-> ReadPrec a
-> ReadPrec [a]
-> T:Read aRead ProgramDb where
readsPrec p s =
[ (emptyProgramDb :: ProgramDbemptyProgramDb { configuredProgs = fromList :: Ord k => [(k, a)] -> Map k aMap.fromList s' :: [(String, ConfiguredProgram)]s' }, r :: Stringr)
| (s', r) <- readsPrec :: Read a => Int -> ReadS areadsPrec p :: Intp s :: Strings ]
restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb
restoreProgramDb = addKnownPrograms :: [Program] -> ProgramDb -> ProgramDbaddKnownPrograms
addKnownProgram :: Program -> ProgramDb -> ProgramDb
addKnownProgram prog = updateUnconfiguredProgs ::
(UnconfiguredProgs -> UnconfiguredProgs) -> ProgramDb -> ProgramDbupdateUnconfiguredProgs ($) :: (a -> b) -> a -> b$
insertWith ::
Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k aMap.insertWith combine :: t -> (t, t, t) -> (Program, t, t)combine (programName :: Program -> StringprogramName prog :: Stringprog) (prog :: Stringprog, Nothing :: Maybe aNothing, [] :: [a][])
where combine _ (_, path, args) = (prog :: Stringprog, path :: Maybe FilePathpath, args :: [ProgArg]args)
addKnownPrograms :: [Program] -> ProgramDb -> ProgramDb
addKnownPrograms progs conf = foldl' :: (a -> b -> a) -> a -> [b] -> afoldl' (flip :: (a -> b -> c) -> b -> a -> cflip addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram) conf :: ProgramDbconf progs :: [Program]progs
lookupKnownProgram :: String -> ProgramDb -> Maybe Program
lookupKnownProgram name =
fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (\(p,_,_)->p :: Intp) (.) :: (b -> c) -> (a -> b) -> a -> c. lookup :: Ord k => k -> Map k a -> Maybe aMap.lookup name :: Stringname (.) :: (b -> c) -> (a -> b) -> a -> c. unconfiguredProgs :: ProgramDb -> UnconfiguredProgsunconfiguredProgs
knownPrograms :: ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms conf =
[ (p :: Intp,p' :: Maybe ConfiguredProgramp') | (p,_,_) <- elems :: Map k a -> [a]Map.elems (unconfiguredProgs :: ProgramDb -> UnconfiguredProgsunconfiguredProgs conf :: ProgramDbconf)
, let p' = lookup :: Ord k => k -> Map k a -> Maybe aMap.lookup (programName :: Program -> StringprogramName p :: Intp) (configuredProgs :: ProgramDb -> ConfiguredProgsconfiguredProgs conf :: ProgramDbconf) ]
userSpecifyPath :: String
-> FilePath
-> ProgramDb -> ProgramDb
userSpecifyPath name path = updateUnconfiguredProgs ::
(UnconfiguredProgs -> UnconfiguredProgs) -> ProgramDb -> ProgramDbupdateUnconfiguredProgs ($) :: (a -> b) -> a -> b$
flip :: (a -> b -> c) -> b -> a -> cflip update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k aMap.update name :: Stringname ($) :: (a -> b) -> a -> b$ \(prog, _, args) -> Just :: a -> Maybe aJust (prog :: Stringprog, Just :: a -> Maybe aJust path :: Maybe FilePathpath, args :: [ProgArg]args)
userMaybeSpecifyPath :: String -> Maybe FilePath
-> ProgramDb -> ProgramDb
userMaybeSpecifyPath _ Nothing conf = conf :: ProgramDbconf
userMaybeSpecifyPath name (Just path) conf = userSpecifyPath :: String -> FilePath -> ProgramDb -> ProgramDbuserSpecifyPath name :: Stringname path :: Maybe FilePathpath conf :: ProgramDbconf
userSpecifyArgs :: String
-> [ProgArg]
-> ProgramDb
-> ProgramDb
userSpecifyArgs name args' =
updateUnconfiguredProgs ::
(UnconfiguredProgs -> UnconfiguredProgs) -> ProgramDb -> ProgramDbupdateUnconfiguredProgs
(flip :: (a -> b -> c) -> b -> a -> cflip update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k aMap.update name :: Stringname ($) :: (a -> b) -> a -> b$
\(prog, path, args) -> Just :: a -> Maybe aJust (prog :: Stringprog, path :: Maybe FilePathpath, args :: [ProgArg]args (++) :: [a] -> [a] -> [a]++ args' :: [ProgArg]args'))
(.) :: (b -> c) -> (a -> b) -> a -> c. updateConfiguredProgs ::
(ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDbupdateConfiguredProgs
(flip :: (a -> b -> c) -> b -> a -> cflip update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k aMap.update name :: Stringname ($) :: (a -> b) -> a -> b$
\prog -> Just :: a -> Maybe aJust prog :: Stringprog { programOverrideArgs = programOverrideArgs :: ConfiguredProgram -> [String]programOverrideArgs prog :: Stringprog
(++) :: [a] -> [a] -> [a]++ args' :: [ProgArg]args' })
userSpecifyPaths :: [(String, FilePath)]
-> ProgramDb
-> ProgramDb
userSpecifyPaths paths conf =
foldl' :: (a -> b -> a) -> a -> [b] -> afoldl' (\conf' (prog, path) -> userSpecifyPath :: String -> FilePath -> ProgramDb -> ProgramDbuserSpecifyPath prog :: Stringprog path :: Maybe FilePathpath conf' :: ProgramDbconf') conf :: ProgramDbconf paths :: [(String, FilePath)]paths
userSpecifyArgss :: [(String, [ProgArg])]
-> ProgramDb
-> ProgramDb
userSpecifyArgss argss conf =
foldl' :: (a -> b -> a) -> a -> [b] -> afoldl' (\conf' (prog, args) -> userSpecifyArgs :: String -> [ProgArg] -> ProgramDb -> ProgramDbuserSpecifyArgs prog :: Stringprog args :: [ProgArg]args conf' :: ProgramDbconf') conf :: ProgramDbconf argss :: [(String, [ProgArg])]argss
userSpecifiedPath :: Program -> ProgramDb -> Maybe FilePath
userSpecifiedPath prog =
join :: Monad m => m (m a) -> m ajoin (.) :: (b -> c) -> (a -> b) -> a -> c. fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (\(_,p,_)->p :: Intp) (.) :: (b -> c) -> (a -> b) -> a -> c. lookup :: Ord k => k -> Map k a -> Maybe aMap.lookup (programName :: Program -> StringprogramName prog :: Stringprog) (.) :: (b -> c) -> (a -> b) -> a -> c. unconfiguredProgs :: ProgramDb -> UnconfiguredProgsunconfiguredProgs
userSpecifiedArgs :: Program -> ProgramDb -> [ProgArg]
userSpecifiedArgs prog =
maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] (\(_,_,as)->as :: [ProgArg]as) (.) :: (b -> c) -> (a -> b) -> a -> c. lookup :: Ord k => k -> Map k a -> Maybe aMap.lookup (programName :: Program -> StringprogramName prog :: Stringprog) (.) :: (b -> c) -> (a -> b) -> a -> c. unconfiguredProgs :: ProgramDb -> UnconfiguredProgsunconfiguredProgs
lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram prog = lookup :: Ord k => k -> Map k a -> Maybe aMap.lookup (programName :: Program -> StringprogramName prog :: Stringprog) (.) :: (b -> c) -> (a -> b) -> a -> c. configuredProgs :: ProgramDb -> ConfiguredProgsconfiguredProgs
updateProgram :: ConfiguredProgram -> ProgramDb
-> ProgramDb
updateProgram prog = updateConfiguredProgs ::
(ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDbupdateConfiguredProgs ($) :: (a -> b) -> a -> b$
insert :: Ord k => k -> a -> Map k a -> Map k aMap.insert (programId :: ConfiguredProgram -> StringprogramId prog :: Stringprog) prog :: Stringprog
configureProgram :: Verbosity
-> Program
-> ProgramDb
-> IO ProgramDb
configureProgram verbosity prog conf = do
let name = programName :: Program -> StringprogramName prog :: Stringprog
maybeLocation <- case userSpecifiedPath :: Program -> ProgramDb -> Maybe FilePathuserSpecifiedPath prog :: Stringprog conf :: ProgramDbconf of
Nothing -> programFindLocation :: Program -> Verbosity -> IO (Maybe FilePath)programFindLocation prog :: Stringprog verbosity :: Verbosityverbosity
(>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap FoundOnSystem :: FilePath -> ProgramLocationFoundOnSystem
Just path -> do
absolute <- doesFileExist :: FilePath -> IO BooldoesFileExist path :: Maybe FilePathpath
if absolute :: Boolabsolute
then return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust (UserSpecified :: FilePath -> ProgramLocationUserSpecified path :: Maybe FilePathpath))
else findProgramLocation :: Verbosity -> FilePath -> IO (Maybe FilePath)findProgramLocation verbosity :: Verbosityverbosity path :: Maybe FilePathpath
(>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= maybe :: b -> (a -> b) -> Maybe a -> bmaybe (die :: String -> IO adie notFound :: [Char]notFound) (return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Just :: a -> Maybe aJust (.) :: (b -> c) -> (a -> b) -> a -> c. UserSpecified :: FilePath -> ProgramLocationUserSpecified)
where notFound = "Cannot find the program '" (++) :: [a] -> [a] -> [a]++ name :: Stringname (++) :: [a] -> [a] -> [a]++ "' at '"
(++) :: [a] -> [a] -> [a]++ path :: Maybe FilePathpath (++) :: [a] -> [a] -> [a]++ "' or on the path"
case maybeLocation :: Maybe ProgramLocationmaybeLocation of
Nothing -> return :: Monad m => forall a. a -> m areturn conf :: ProgramDbconf
Just location -> do
version <- programFindVersion ::
Program -> Verbosity -> FilePath -> IO (Maybe Version)programFindVersion prog :: Stringprog verbosity :: Verbosityverbosity (locationPath :: ProgramLocation -> FilePathlocationPath location :: ProgramLocationlocation)
let configuredProg = ConfiguredProgram {
programId = name :: Stringname,
programVersion = version :: Versionversion,
programDefaultArgs = [] :: [a][],
programOverrideArgs = userSpecifiedArgs :: Program -> ProgramDb -> [ProgArg]userSpecifiedArgs prog :: Stringprog conf :: ProgramDbconf,
programLocation = location :: ProgramLocationlocation
}
extraArgs <- programPostConf ::
Program -> Verbosity -> ConfiguredProgram -> IO [ProgArg]programPostConf prog :: Stringprog verbosity :: Verbosityverbosity configuredProg :: ConfiguredProgramconfiguredProg
let configuredProg' = configuredProg :: ConfiguredProgramconfiguredProg {
programDefaultArgs = extraArgs :: [ProgArg]extraArgs
}
return :: Monad m => forall a. a -> m areturn (updateConfiguredProgs ::
(ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDbupdateConfiguredProgs (insert :: Ord k => k -> a -> Map k a -> Map k aMap.insert name :: Stringname configuredProg' :: ConfiguredProgramconfiguredProg') conf :: ProgramDbconf)
configurePrograms :: Verbosity
-> [Program]
-> ProgramDb
-> IO ProgramDb
configurePrograms verbosity progs conf =
foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m afoldM (flip :: (a -> b -> c) -> b -> a -> cflip (configureProgram ::
Verbosity -> Program -> ProgramDb -> IO ProgramDbconfigureProgram verbosity :: Verbosityverbosity)) conf :: ProgramDbconf progs :: [Program]progs
configureAllKnownPrograms :: Verbosity
-> ProgramDb
-> IO ProgramDb
configureAllKnownPrograms verbosity conf =
configurePrograms ::
Verbosity -> [Program] -> ProgramDb -> IO ProgramDbconfigurePrograms verbosity :: Verbosityverbosity
[ prog :: Stringprog | (prog,_,_) <- elems :: Map k a -> [a]Map.elems notYetConfigured :: Map String UnconfiguredProgramnotYetConfigured ] conf :: ProgramDbconf
where
notYetConfigured = unconfiguredProgs :: ProgramDb -> UnconfiguredProgsunconfiguredProgs conf :: ProgramDbconf
difference :: Ord k => Map k a -> Map k b -> Map k a`Map.difference` configuredProgs :: ProgramDb -> ConfiguredProgsconfiguredProgs conf :: ProgramDbconf
reconfigurePrograms :: Verbosity
-> [(String, FilePath)]
-> [(String, [ProgArg])]
-> ProgramDb
-> IO ProgramDb
reconfigurePrograms verbosity paths argss conf = do
configurePrograms ::
Verbosity -> [Program] -> ProgramDb -> IO ProgramDbconfigurePrograms verbosity :: Verbosityverbosity progs :: [Program]progs
(.) :: (b -> c) -> (a -> b) -> a -> c. userSpecifyPaths :: [(String, FilePath)] -> ProgramDb -> ProgramDbuserSpecifyPaths paths :: [(String, FilePath)]paths
(.) :: (b -> c) -> (a -> b) -> a -> c. userSpecifyArgss :: [(String, [ProgArg])] -> ProgramDb -> ProgramDbuserSpecifyArgss argss :: [(String, [ProgArg])]argss
($) :: (a -> b) -> a -> b$ conf :: ProgramDbconf
where
progs = catMaybes :: [Maybe a] -> [a]catMaybes [ lookupKnownProgram :: String -> ProgramDb -> Maybe ProgramlookupKnownProgram name :: Stringname conf :: ProgramDbconf | (name,_) <- paths :: [(String, FilePath)]paths ]
requireProgram :: Verbosity -> Program -> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)
requireProgram verbosity prog conf = do
conf' <- case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram prog :: Stringprog conf :: ProgramDbconf of
Nothing -> configureProgram ::
Verbosity -> Program -> ProgramDb -> IO ProgramDbconfigureProgram verbosity :: Verbosityverbosity prog :: Stringprog conf :: ProgramDbconf
Just _ -> return :: Monad m => forall a. a -> m areturn conf :: ProgramDbconf
case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram prog :: Stringprog conf' :: ProgramDbconf' of
Nothing -> die :: String -> IO adie notFound :: [Char]notFound
Just configuredProg -> return :: Monad m => forall a. a -> m areturn (configuredProg :: ConfiguredProgramconfiguredProg, conf' :: ProgramDbconf')
where notFound = "The program " (++) :: [a] -> [a] -> [a]++ programName :: Program -> StringprogramName prog :: Stringprog
(++) :: [a] -> [a] -> [a]++ " is required but it could not be found."
requireProgramVersion :: Verbosity -> Program -> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion verbosity prog range conf = do
conf' <- case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram prog :: Stringprog conf :: ProgramDbconf of
Nothing -> configureProgram ::
Verbosity -> Program -> ProgramDb -> IO ProgramDbconfigureProgram verbosity :: Verbosityverbosity prog :: Stringprog conf :: ProgramDbconf
Just _ -> return :: Monad m => forall a. a -> m areturn conf :: ProgramDbconf
case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram prog :: Stringprog conf' :: ProgramDbconf' of
Nothing -> die :: String -> IO adie notFound :: [Char]notFound
Just configuredProg@ConfiguredProgram { programLocation = location } ->
case programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion configuredProg :: ConfiguredProgramconfiguredProg of
Just version
| withinRange :: Version -> VersionRange -> BoolwithinRange version :: Versionversion range :: VersionRangerange -> return :: Monad m => forall a. a -> m areturn (configuredProg :: ConfiguredProgramconfiguredProg, version :: Versionversion, conf' :: ProgramDbconf')
| otherwise :: Boolotherwise -> die :: String -> IO adie (badVersion :: a -> ProgramLocation -> [Char]badVersion version :: Versionversion location :: ProgramLocationlocation)
Nothing -> die :: String -> IO adie (noVersion :: ProgramLocation -> [Char]noVersion location :: ProgramLocationlocation)
where notFound = "The program "
(++) :: [a] -> [a] -> [a]++ programName :: Program -> StringprogramName prog :: Stringprog (++) :: [a] -> [a] -> [a]++ versionRequirement :: [Char]versionRequirement
(++) :: [a] -> [a] -> [a]++ " is required but it could not be found."
badVersion v l = "The program "
(++) :: [a] -> [a] -> [a]++ programName :: Program -> StringprogramName prog :: Stringprog (++) :: [a] -> [a] -> [a]++ versionRequirement :: [Char]versionRequirement
(++) :: [a] -> [a] -> [a]++ " is required but the version found at "
(++) :: [a] -> [a] -> [a]++ locationPath :: ProgramLocation -> FilePathlocationPath l :: ProgramLocationl (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay v :: av
noVersion l = "The program "
(++) :: [a] -> [a] -> [a]++ programName :: Program -> StringprogramName prog :: Stringprog (++) :: [a] -> [a] -> [a]++ versionRequirement :: [Char]versionRequirement
(++) :: [a] -> [a] -> [a]++ " is required but the version of "
(++) :: [a] -> [a] -> [a]++ locationPath :: ProgramLocation -> FilePathlocationPath l :: ProgramLocationl (++) :: [a] -> [a] -> [a]++ " could not be determined."
versionRequirement
| isAnyVersion :: VersionRange -> BoolisAnyVersion range :: VersionRangerange = ""
| otherwise :: Boolotherwise = " version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay range :: VersionRangerange