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

-----------------------------------------------------------------------------
-- |
-- 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(..),
    simpleProgram,

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

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.PackageDescription
import Distribution.Simple.Program.Find
import Distribution.Version
import Distribution.Verbosity

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 {
       -- | The simple name of the program, eg. ghc
       Program -> String
programName :: String,

       -- | 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 -> ProgramSearchPath -> IO (Maybe (String, [String]))
Evidence bound by a HsWrapper of the constraint type HasCallStack
Evidence bound by a HsWrapper of the constraint type HasCallStack
programFindLocation :: Verbosity -> ProgramSearchPath
                              -> IO (Maybe (FilePath, [FilePath])),

       -- | 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 -> String -> IO (Maybe Version)
Evidence bound by a HsWrapper of the constraint type HasCallStack
Evidence bound by a HsWrapper of the constraint type HasCallStack
programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version),

       -- | 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 -> Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
Evidence bound by a HsWrapper of the constraint type HasCallStack
Evidence bound by a HsWrapper of the constraint type HasCallStack
programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram,
       -- | 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.
       Program
-> Maybe Version -> PackageDescription -> [String] -> [String]
programNormaliseArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
     }
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

-- | 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 {
       -- | Just the name again
       ConfiguredProgram -> String
programId :: String,

       -- | The version of this program, if it is known.
       ConfiguredProgram -> Maybe Version
programVersion :: Maybe Version,

       -- | 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]
programDefaultArgs :: [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]
programOverrideArgs :: [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 -> [(String, Maybe String)]
programOverrideEnv :: [(String, Maybe 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 -> Map String String
programProperties :: Map.Map String String,

       -- | Location of the program. eg. @\/usr\/bin\/ghc-6.4@
       ConfiguredProgram -> ProgramLocation
programLocation :: ProgramLocation,

       -- | 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).
       --
       ConfiguredProgram -> [String]
programMonitorFiles :: [FilePath]
     }
  deriving (ConfiguredProgram -> ConfiguredProgram -> Bool
(ConfiguredProgram -> ConfiguredProgram -> Bool)
-> (ConfiguredProgram -> ConfiguredProgram -> Bool)
-> Eq ConfiguredProgram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfiguredProgram -> ConfiguredProgram -> Bool
$c/= :: ConfiguredProgram -> ConfiguredProgram -> Bool
== :: ConfiguredProgram -> ConfiguredProgram -> Bool
$c== :: ConfiguredProgram -> ConfiguredProgram -> Bool
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq Version
External instance of the constraint type Eq Char
External instance of the constraint type forall k a. (Eq k, Eq a) => Eq (Map k a)
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Eq Version
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
Instance of class: Eq of the constraint type Eq ProgramLocation
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
$cto :: forall x. Rep ConfiguredProgram x -> ConfiguredProgram
$cfrom :: forall x. ConfiguredProgram -> Rep ConfiguredProgram x
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
readListPrec :: ReadPrec [ConfiguredProgram]
$creadListPrec :: ReadPrec [ConfiguredProgram]
readPrec :: ReadPrec ConfiguredProgram
$creadPrec :: ReadPrec ConfiguredProgram
readList :: ReadS [ConfiguredProgram]
$creadList :: ReadS [ConfiguredProgram]
readsPrec :: Int -> ReadS ConfiguredProgram
$creadsPrec :: Int -> ReadS ConfiguredProgram
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read Version
External instance of the constraint type Read Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type forall k e. (Ord k, Read k, Read e) => Read (Map k e)
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Read Version
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read ProgramLocation
Instance of class: Read of the constraint type Read 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
showList :: [ConfiguredProgram] -> ShowS
$cshowList :: [ConfiguredProgram] -> ShowS
show :: ConfiguredProgram -> String
$cshow :: ConfiguredProgram -> String
showsPrec :: Int -> ConfiguredProgram -> ShowS
$cshowsPrec :: Int -> ConfiguredProgram -> ShowS
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show Version
External instance of the constraint type Show Char
External instance of the constraint type forall k a. (Show k, Show a) => Show (Map k a)
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Show Version
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show ProgramLocation
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
    = UserSpecified { ProgramLocation -> String
locationPath :: FilePath }
      -- ^The user gave the path to this program,
      -- eg. --ghc-path=\/usr\/bin\/ghc-6.6
    | FoundOnSystem { locationPath :: FilePath }
      -- ^The program was found automatically.
      deriving (ProgramLocation -> ProgramLocation -> Bool
(ProgramLocation -> ProgramLocation -> Bool)
-> (ProgramLocation -> ProgramLocation -> Bool)
-> Eq ProgramLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProgramLocation -> ProgramLocation -> Bool
$c/= :: ProgramLocation -> ProgramLocation -> Bool
== :: ProgramLocation -> ProgramLocation -> Bool
$c== :: ProgramLocation -> ProgramLocation -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
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
$cto :: forall x. Rep ProgramLocation x -> ProgramLocation
$cfrom :: forall x. ProgramLocation -> Rep ProgramLocation x
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
readListPrec :: ReadPrec [ProgramLocation]
$creadListPrec :: ReadPrec [ProgramLocation]
readPrec :: ReadPrec ProgramLocation
$creadPrec :: ReadPrec ProgramLocation
readList :: ReadS [ProgramLocation]
$creadList :: ReadS [ProgramLocation]
readsPrec :: Int -> ReadS ProgramLocation
$creadsPrec :: Int -> ReadS ProgramLocation
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read 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
showList :: [ProgramLocation] -> ShowS
$cshowList :: [ProgramLocation] -> ShowS
show :: ProgramLocation -> String
$cshow :: ProgramLocation -> String
showsPrec :: Int -> ProgramLocation -> ShowS
$cshowsPrec :: Int -> ProgramLocation -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Ord Int
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
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 :: [String]
programOverrideArgs = [] }

-- | Make a simple named program.
--
-- By default we'll just search for it in the path and not try to find the
-- version name. You can override these behaviours if necessary, eg:
--
-- > (simpleProgram "foo") { programFindLocation = ... , programFindVersion ... }
--
simpleProgram :: String -> Program
simpleProgram :: String -> Program
simpleProgram String
name = Program :: String
-> (Verbosity
    -> ProgramSearchPath -> IO (Maybe (String, [String])))
-> (Verbosity -> String -> IO (Maybe Version))
-> (Verbosity -> ConfiguredProgram -> IO ConfiguredProgram)
-> (Maybe Version -> PackageDescription -> [String] -> [String])
-> Program
Program {
    programName :: String
programName         = String
name,
    programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation = \Verbosity
v ProgramSearchPath
p -> Verbosity
-> ProgramSearchPath -> String -> IO (Maybe (String, [String]))
findProgramOnSearchPath Verbosity
v ProgramSearchPath
p String
name,
    programFindVersion :: Verbosity -> String -> IO (Maybe Version)
programFindVersion  = \Verbosity
_ String
_ -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Maybe Version
forall a. Maybe a
Nothing,
    programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
programPostConf     = \Verbosity
_ ConfiguredProgram
p -> ConfiguredProgram -> IO ConfiguredProgram
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ConfiguredProgram
p,
    programNormaliseArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
programNormaliseArgs   = \Maybe Version
_ PackageDescription
_ -> [String] -> [String]
forall a. a -> a
id
  }

-- | Make a simple 'ConfiguredProgram'.
--
-- > simpleConfiguredProgram "foo" (FoundOnSystem path)
--
simpleConfiguredProgram :: String -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram :: String -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram String
name ProgramLocation
loc = ConfiguredProgram :: String
-> Maybe Version
-> [String]
-> [String]
-> [(String, Maybe String)]
-> Map String String
-> ProgramLocation
-> [String]
-> ConfiguredProgram
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
  }