{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.Program (
Program(..)
, ProgramSearchPath
, ProgramSearchPathEntry(..)
, simpleProgram
, findProgramOnSearchPath
, defaultProgramSearchPath
, findProgramVersion
, ConfiguredProgram(..)
, programPath
, ProgArg
, ProgramLocation(..)
, runProgram
, getProgramOutput
, suppressOverrideArgs
, ProgramInvocation(..)
, emptyProgramInvocation
, simpleProgramInvocation
, programInvocation
, runProgramInvocation
, getProgramInvocationOutput
, getProgramInvocationLBS
, builtinPrograms
, ProgramDb
, defaultProgramDb
, emptyProgramDb
, restoreProgramDb
, addKnownProgram
, addKnownPrograms
, lookupKnownProgram
, knownPrograms
, getProgramSearchPath
, setProgramSearchPath
, userSpecifyPath
, userSpecifyPaths
, userMaybeSpecifyPath
, userSpecifyArgs
, userSpecifyArgss
, userSpecifiedArgs
, lookupProgram
, lookupProgramVersion
, updateProgram
, configureProgram
, configureAllKnownPrograms
, reconfigurePrograms
, requireProgram
, requireProgramVersion
, needProgram
, runDbProgram
, getDbProgramOutput
, ghcProgram
, ghcPkgProgram
, ghcjsProgram
, ghcjsPkgProgram
, hmakeProgram
, jhcProgram
, uhcProgram
, gccProgram
, arProgram
, stripProgram
, happyProgram
, alexProgram
, hsc2hsProgram
, c2hsProgram
, cpphsProgram
, hscolourProgram
, doctestProgram
, haddockProgram
, greencardProgram
, ldProgram
, tarProgram
, cppProgram
, pkgConfigProgram
, hpcProgram
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Db
import Distribution.Simple.Program.Builtin
import Distribution.Simple.Program.Find
import Distribution.Simple.Utils
import Distribution.Verbosity
runProgram :: Verbosity
-> ConfiguredProgram
-> [ProgArg]
-> IO ()
runProgram :: Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
prog [ProgArg]
args =
Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (ConfiguredProgram -> [ProgArg] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [ProgArg]
args)
getProgramOutput :: Verbosity
-> ConfiguredProgram
-> [ProgArg]
-> IO String
getProgramOutput :: Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ProgArg
getProgramOutput Verbosity
verbosity ConfiguredProgram
prog [ProgArg]
args =
Verbosity -> ProgramInvocation -> IO ProgArg
getProgramInvocationOutput Verbosity
verbosity (ConfiguredProgram -> [ProgArg] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [ProgArg]
args)
runDbProgram :: Verbosity
-> Program
-> ProgramDb
-> [ProgArg]
-> IO ()
runDbProgram :: Verbosity -> Program -> ProgramDb -> [ProgArg] -> IO ()
runDbProgram Verbosity
verbosity Program
prog ProgramDb
programDb [ProgArg]
args =
case Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
programDb of
Maybe ConfiguredProgram
Nothing -> forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity ProgArg
notFound
Just ConfiguredProgram
configuredProg -> Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
configuredProg [ProgArg]
args
where
notFound :: ProgArg
notFound = ProgArg
"The program '" forall a. [a] -> [a] -> [a]
++ Program -> ProgArg
programName Program
prog
forall a. [a] -> [a] -> [a]
++ ProgArg
"' is required but it could not be found"
getDbProgramOutput :: Verbosity
-> Program
-> ProgramDb
-> [ProgArg]
-> IO String
getDbProgramOutput :: Verbosity -> Program -> ProgramDb -> [ProgArg] -> IO ProgArg
getDbProgramOutput Verbosity
verbosity Program
prog ProgramDb
programDb [ProgArg]
args =
case Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
programDb of
Maybe ConfiguredProgram
Nothing -> forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity ProgArg
notFound
Just ConfiguredProgram
configuredProg -> Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ProgArg
getProgramOutput Verbosity
verbosity ConfiguredProgram
configuredProg [ProgArg]
args
where
notFound :: ProgArg
notFound = ProgArg
"The program '" forall a. [a] -> [a] -> [a]
++ Program -> ProgArg
programName Program
prog
forall a. [a] -> [a] -> [a]
++ ProgArg
"' is required but it could not be found"