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

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

-- |
-- Module      :  Distribution.Simple.Program.Types
-- Copyright   :  Isaac Jones 2006, Duncan Coutts 2007-2009
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This provides an abstraction which deals with configuring and running
-- programs. A 'Program' is a static notion of a known program. A
-- 'ConfiguredProgram' is a 'Program' that has been found on the current
-- machine and is ready to be run (possibly with some user-supplied default
-- args). Configuring a program involves finding its location and if necessary
-- finding its version. There's reasonable default behavior for trying to find
-- \"foo\" in PATH, being able to override its location, etc.
module Distribution.Simple.Program.Types
  ( -- * Program and functions for constructing them
    Program (..)
  , ProgramSearchPath
  , ProgramSearchPathEntry (..)

    -- * Configured program and related functions
  , ConfiguredProgram (..)
  , programPath
  , suppressOverrideArgs
  , ProgArg
  , ProgramLocation (..)
  , simpleConfiguredProgram
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.PackageDescription
import Distribution.Verbosity
import Distribution.Version

import qualified Data.Map as Map

-- | Represents a program which can be configured.
--
-- Note: rather than constructing this directly, start with 'simpleProgram' and
-- override any extra fields.
data Program = Program
  { Program -> String
programName :: String
  -- ^ The simple name of the program, eg. ghc
  , Program
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation
      :: Verbosity
      -> ProgramSearchPath
      -> IO (Maybe (FilePath, [FilePath]))
  -- ^ A function to search for the program if its location was not
  -- specified by the user. Usually this will just be a call to
  -- 'findProgramOnSearchPath'.
  --
  -- It is supplied with the prevailing search path which will typically
  -- just be used as-is, but can be extended or ignored as needed.
  --
  -- For the purpose of change monitoring, in addition to the location
  -- where the program was found, it returns all the other places that
  -- were tried.
  , Program -> Verbosity -> String -> IO (Maybe Version)
programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
  -- ^ Try to find the version of the program. For many programs this is
  -- not possible or is not necessary so it's OK to return Nothing.
  , Program -> Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
  -- ^ A function to do any additional configuration after we have
  -- located the program (and perhaps identified its version). For example
  -- it could add args, or environment vars.
  , Program
-> Maybe Version -> PackageDescription -> [String] -> [String]
programNormaliseArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
  -- ^ A function that filters any arguments that don't impact the output
  -- from a commandline. Used to limit the volatility of dependency hashes
  -- when using new-build.
  }

instance Show Program where
  show :: Program -> String
show (Program String
name Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
_ Verbosity -> String -> IO (Maybe Version)
_ Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
_ Maybe Version -> PackageDescription -> [String] -> [String]
_) = String
"Program: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name

type ProgArg = String

-- | A search path to use when locating executables. This is analogous
-- to the unix @$PATH@ or win32 @%PATH%@ but with the ability to use
-- the system default method for finding executables ('findExecutable' which
-- on unix is simply looking on the @$PATH@ but on win32 is a bit more
-- complicated).
--
-- The default to use is @[ProgSearchPathDefault]@ but you can add extra dirs
-- either before, after or instead of the default, e.g. here we add an extra
-- dir to search after the usual ones.
--
-- > ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir]
--
-- We also use this path to set the environment when running child processes.
--
-- The @ProgramDb@ is created with a @ProgramSearchPath@ to which we
-- @appendProgramSearchPath@ to add the ones that come from cli flags and from
-- configurations. Then each of the programs that are configured in the db
-- inherits the same path as part of @configureProgram@.
type ProgramSearchPath = [ProgramSearchPathEntry]

data ProgramSearchPathEntry
  = -- | A specific dir
    ProgramSearchPathDir FilePath
  | -- | The system default
    ProgramSearchPathDefault
  deriving (ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
(ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool)
-> (ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool)
-> Eq ProgramSearchPathEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
== :: ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
$c/= :: ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
/= :: ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
Eq, (forall x. ProgramSearchPathEntry -> Rep ProgramSearchPathEntry x)
-> (forall x.
    Rep ProgramSearchPathEntry x -> ProgramSearchPathEntry)
-> Generic ProgramSearchPathEntry
forall x. Rep ProgramSearchPathEntry x -> ProgramSearchPathEntry
forall x. ProgramSearchPathEntry -> Rep ProgramSearchPathEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProgramSearchPathEntry -> Rep ProgramSearchPathEntry x
from :: forall x. ProgramSearchPathEntry -> Rep ProgramSearchPathEntry x
$cto :: forall x. Rep ProgramSearchPathEntry x -> ProgramSearchPathEntry
to :: forall x. Rep ProgramSearchPathEntry x -> ProgramSearchPathEntry
Generic, Typeable)

instance Binary ProgramSearchPathEntry
instance Structured ProgramSearchPathEntry

-- | Represents a program which has been configured and is thus ready to be run.
--
-- These are usually made by configuring a 'Program', but if you have to
-- construct one directly then start with 'simpleConfiguredProgram' and
-- override any extra fields.
data ConfiguredProgram = ConfiguredProgram
  { ConfiguredProgram -> String
programId :: String
  -- ^ Just the name again
  , ConfiguredProgram -> Maybe Version
programVersion :: Maybe Version
  -- ^ The version of this program, if it is known.
  , ConfiguredProgram -> [String]
programDefaultArgs :: [String]
  -- ^ Default command-line args for this program.
  -- These flags will appear first on the command line, so they can be
  -- overridden by subsequent flags.
  , ConfiguredProgram -> [String]
programOverrideArgs :: [String]
  -- ^ Override command-line args for this program.
  -- These flags will appear last on the command line, so they override
  -- all earlier flags.
  , ConfiguredProgram -> [(String, Maybe String)]
programOverrideEnv :: [(String, Maybe String)]
  -- ^ Override environment variables for this program.
  -- These env vars will extend\/override the prevailing environment of
  -- the current to form the environment for the new process.
  , ConfiguredProgram -> Map String String
programProperties :: Map.Map String String
  -- ^ A key-value map listing various properties of the program, useful
  -- for feature detection. Populated during the configuration step, key
  -- names depend on the specific program.
  , ConfiguredProgram -> ProgramLocation
programLocation :: ProgramLocation
  -- ^ Location of the program. eg. @\/usr\/bin\/ghc-6.4@
  , ConfiguredProgram -> [String]
programMonitorFiles :: [FilePath]
  -- ^ In addition to the 'programLocation' where the program was found,
  -- these are additional locations that were looked at. The combination
  -- of ths found location and these not-found locations can be used to
  -- monitor to detect when the re-configuring the program might give a
  -- different result (e.g. found in a different location).
  }
  deriving (ConfiguredProgram -> ConfiguredProgram -> Bool
(ConfiguredProgram -> ConfiguredProgram -> Bool)
-> (ConfiguredProgram -> ConfiguredProgram -> Bool)
-> Eq ConfiguredProgram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfiguredProgram -> ConfiguredProgram -> Bool
== :: ConfiguredProgram -> ConfiguredProgram -> Bool
$c/= :: ConfiguredProgram -> ConfiguredProgram -> Bool
/= :: ConfiguredProgram -> ConfiguredProgram -> Bool
Eq, (forall x. ConfiguredProgram -> Rep ConfiguredProgram x)
-> (forall x. Rep ConfiguredProgram x -> ConfiguredProgram)
-> Generic ConfiguredProgram
forall x. Rep ConfiguredProgram x -> ConfiguredProgram
forall x. ConfiguredProgram -> Rep ConfiguredProgram x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfiguredProgram -> Rep ConfiguredProgram x
from :: forall x. ConfiguredProgram -> Rep ConfiguredProgram x
$cto :: forall x. Rep ConfiguredProgram x -> ConfiguredProgram
to :: forall x. Rep ConfiguredProgram x -> ConfiguredProgram
Generic, ReadPrec [ConfiguredProgram]
ReadPrec ConfiguredProgram
Int -> ReadS ConfiguredProgram
ReadS [ConfiguredProgram]
(Int -> ReadS ConfiguredProgram)
-> ReadS [ConfiguredProgram]
-> ReadPrec ConfiguredProgram
-> ReadPrec [ConfiguredProgram]
-> Read ConfiguredProgram
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConfiguredProgram
readsPrec :: Int -> ReadS ConfiguredProgram
$creadList :: ReadS [ConfiguredProgram]
readList :: ReadS [ConfiguredProgram]
$creadPrec :: ReadPrec ConfiguredProgram
readPrec :: ReadPrec ConfiguredProgram
$creadListPrec :: ReadPrec [ConfiguredProgram]
readListPrec :: ReadPrec [ConfiguredProgram]
Read, Int -> ConfiguredProgram -> ShowS
[ConfiguredProgram] -> ShowS
ConfiguredProgram -> String
(Int -> ConfiguredProgram -> ShowS)
-> (ConfiguredProgram -> String)
-> ([ConfiguredProgram] -> ShowS)
-> Show ConfiguredProgram
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfiguredProgram -> ShowS
showsPrec :: Int -> ConfiguredProgram -> ShowS
$cshow :: ConfiguredProgram -> String
show :: ConfiguredProgram -> String
$cshowList :: [ConfiguredProgram] -> ShowS
showList :: [ConfiguredProgram] -> ShowS
Show, Typeable)

instance Binary ConfiguredProgram
instance Structured ConfiguredProgram

-- | Where a program was found. Also tells us whether it's specified by user or
-- not.  This includes not just the path, but the program as well.
data ProgramLocation
  = -- | The user gave the path to this program,
    --  eg. --ghc-path=\/usr\/bin\/ghc-6.6
    UserSpecified {ProgramLocation -> String
locationPath :: FilePath}
  | -- | The program was found automatically.
    FoundOnSystem {locationPath :: FilePath}
  deriving (ProgramLocation -> ProgramLocation -> Bool
(ProgramLocation -> ProgramLocation -> Bool)
-> (ProgramLocation -> ProgramLocation -> Bool)
-> Eq ProgramLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgramLocation -> ProgramLocation -> Bool
== :: ProgramLocation -> ProgramLocation -> Bool
$c/= :: ProgramLocation -> ProgramLocation -> Bool
/= :: ProgramLocation -> ProgramLocation -> Bool
Eq, (forall x. ProgramLocation -> Rep ProgramLocation x)
-> (forall x. Rep ProgramLocation x -> ProgramLocation)
-> Generic ProgramLocation
forall x. Rep ProgramLocation x -> ProgramLocation
forall x. ProgramLocation -> Rep ProgramLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProgramLocation -> Rep ProgramLocation x
from :: forall x. ProgramLocation -> Rep ProgramLocation x
$cto :: forall x. Rep ProgramLocation x -> ProgramLocation
to :: forall x. Rep ProgramLocation x -> ProgramLocation
Generic, ReadPrec [ProgramLocation]
ReadPrec ProgramLocation
Int -> ReadS ProgramLocation
ReadS [ProgramLocation]
(Int -> ReadS ProgramLocation)
-> ReadS [ProgramLocation]
-> ReadPrec ProgramLocation
-> ReadPrec [ProgramLocation]
-> Read ProgramLocation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ProgramLocation
readsPrec :: Int -> ReadS ProgramLocation
$creadList :: ReadS [ProgramLocation]
readList :: ReadS [ProgramLocation]
$creadPrec :: ReadPrec ProgramLocation
readPrec :: ReadPrec ProgramLocation
$creadListPrec :: ReadPrec [ProgramLocation]
readListPrec :: ReadPrec [ProgramLocation]
Read, Int -> ProgramLocation -> ShowS
[ProgramLocation] -> ShowS
ProgramLocation -> String
(Int -> ProgramLocation -> ShowS)
-> (ProgramLocation -> String)
-> ([ProgramLocation] -> ShowS)
-> Show ProgramLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgramLocation -> ShowS
showsPrec :: Int -> ProgramLocation -> ShowS
$cshow :: ProgramLocation -> String
show :: ProgramLocation -> String
$cshowList :: [ProgramLocation] -> ShowS
showList :: [ProgramLocation] -> ShowS
Show, Typeable)

instance Binary ProgramLocation
instance Structured ProgramLocation

-- | The full path of a configured program.
programPath :: ConfiguredProgram -> FilePath
programPath :: ConfiguredProgram -> String
programPath = ProgramLocation -> String
locationPath (ProgramLocation -> String)
-> (ConfiguredProgram -> ProgramLocation)
-> ConfiguredProgram
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredProgram -> ProgramLocation
programLocation

-- | Suppress any extra arguments added by the user.
suppressOverrideArgs :: ConfiguredProgram -> ConfiguredProgram
suppressOverrideArgs :: ConfiguredProgram -> ConfiguredProgram
suppressOverrideArgs ConfiguredProgram
prog = ConfiguredProgram
prog{programOverrideArgs = []}

-- | Make a simple 'ConfiguredProgram'.
--
-- > simpleConfiguredProgram "foo" (FoundOnSystem path)
simpleConfiguredProgram :: String -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram :: String -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram String
name ProgramLocation
loc =
  ConfiguredProgram
    { programId :: String
programId = String
name
    , programVersion :: Maybe Version
programVersion = Maybe Version
forall a. Maybe a
Nothing
    , programDefaultArgs :: [String]
programDefaultArgs = []
    , programOverrideArgs :: [String]
programOverrideArgs = []
    , programOverrideEnv :: [(String, Maybe String)]
programOverrideEnv = []
    , programProperties :: Map String String
programProperties = Map String String
forall k a. Map k a
Map.empty
    , programLocation :: ProgramLocation
programLocation = ProgramLocation
loc
    , programMonitorFiles :: [String]
programMonitorFiles = [] -- did not look in any other locations
    }