1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE DeriveDataTypeable #-}
6
7-----------------------------------------------------------------------------
8-- |
9-- Module      :  Distribution.Simple.Program.Types
10-- Copyright   :  Isaac Jones 2006, Duncan Coutts 2007-2009
11--
12-- Maintainer  :  cabal-devel@haskell.org
13-- Portability :  portable
14--
15-- This provides an abstraction which deals with configuring and running
16-- programs. A 'Program' is a static notion of a known program. A
17-- 'ConfiguredProgram' is a 'Program' that has been found on the current
18-- machine and is ready to be run (possibly with some user-supplied default
19-- args). Configuring a program involves finding its location and if necessary
20-- finding its version. There's reasonable default behavior for trying to find
21-- \"foo\" in PATH, being able to override its location, etc.
22--
23module Distribution.Simple.Program.Types (
24    -- * Program and functions for constructing them
25    Program(..),
26    ProgramSearchPath,
27    ProgramSearchPathEntry(..),
28    simpleProgram,
29
30    -- * Configured program and related functions
31    ConfiguredProgram(..),
32    programPath,
33    suppressOverrideArgs,
34    ProgArg,
35    ProgramLocation(..),
36    simpleConfiguredProgram,
37  ) where
38
39import Prelude ()
40import Distribution.Compat.Prelude
41
42import Distribution.PackageDescription
43import Distribution.Simple.Program.Find
44import Distribution.Version
45import Distribution.Verbosity
46
47import qualified Data.Map as Map
48
49-- | Represents a program which can be configured.
50--
51-- Note: rather than constructing this directly, start with 'simpleProgram' and
52-- override any extra fields.
53--
54data Program = Program {
55       -- | The simple name of the program, eg. ghc
56       programName :: String,
57
58       -- | A function to search for the program if its location was not
59       -- specified by the user. Usually this will just be a call to
60       -- 'findProgramOnSearchPath'.
61       --
62       -- It is supplied with the prevailing search path which will typically
63       -- just be used as-is, but can be extended or ignored as needed.
64       --
65       -- For the purpose of change monitoring, in addition to the location
66       -- where the program was found, it returns all the other places that
67       -- were tried.
68       --
69       programFindLocation :: Verbosity -> ProgramSearchPath
70                              -> IO (Maybe (FilePath, [FilePath])),
71
72       -- | Try to find the version of the program. For many programs this is
73       -- not possible or is not necessary so it's OK to return Nothing.
74       programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version),
75
76       -- | A function to do any additional configuration after we have
77       -- located the program (and perhaps identified its version). For example
78       -- it could add args, or environment vars.
79       programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram,
80       -- | A function that filters any arguments that don't impact the output
81       -- from a commandline. Used to limit the volatility of dependency hashes
82       -- when using new-build.
83       programNormaliseArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
84     }
85instance Show Program where
86  show (Program name _ _ _ _) = "Program: " ++ name
87
88type ProgArg = String
89
90-- | Represents a program which has been configured and is thus ready to be run.
91--
92-- These are usually made by configuring a 'Program', but if you have to
93-- construct one directly then start with 'simpleConfiguredProgram' and
94-- override any extra fields.
95--
96data ConfiguredProgram = ConfiguredProgram {
97       -- | Just the name again
98       programId :: String,
99
100       -- | The version of this program, if it is known.
101       programVersion :: Maybe Version,
102
103       -- | Default command-line args for this program.
104       -- These flags will appear first on the command line, so they can be
105       -- overridden by subsequent flags.
106       programDefaultArgs :: [String],
107
108       -- | Override command-line args for this program.
109       -- These flags will appear last on the command line, so they override
110       -- all earlier flags.
111       programOverrideArgs :: [String],
112
113       -- | Override environment variables for this program.
114       -- These env vars will extend\/override the prevailing environment of
115       -- the current to form the environment for the new process.
116       programOverrideEnv :: [(String, Maybe String)],
117
118       -- | A key-value map listing various properties of the program, useful
119       -- for feature detection. Populated during the configuration step, key
120       -- names depend on the specific program.
121       programProperties :: Map.Map String String,
122
123       -- | Location of the program. eg. @\/usr\/bin\/ghc-6.4@
124       programLocation :: ProgramLocation,
125
126       -- | In addition to the 'programLocation' where the program was found,
127       -- these are additional locations that were looked at. The combination
128       -- of ths found location and these not-found locations can be used to
129       -- monitor to detect when the re-configuring the program might give a
130       -- different result (e.g. found in a different location).
131       --
132       programMonitorFiles :: [FilePath]
133     }
134  deriving (Eq, Generic, Read, Show, Typeable)
135
136instance Binary ConfiguredProgram
137instance Structured ConfiguredProgram
138
139-- | Where a program was found. Also tells us whether it's specified by user or
140-- not.  This includes not just the path, but the program as well.
141data ProgramLocation
142    = UserSpecified { locationPath :: FilePath }
143      -- ^The user gave the path to this program,
144      -- eg. --ghc-path=\/usr\/bin\/ghc-6.6
145    | FoundOnSystem { locationPath :: FilePath }
146      -- ^The program was found automatically.
147      deriving (Eq, Generic, Read, Show, Typeable)
148
149instance Binary ProgramLocation
150instance Structured ProgramLocation
151
152-- | The full path of a configured program.
153programPath :: ConfiguredProgram -> FilePath
154programPath = locationPath . programLocation
155
156-- | Suppress any extra arguments added by the user.
157suppressOverrideArgs :: ConfiguredProgram -> ConfiguredProgram
158suppressOverrideArgs prog = prog { programOverrideArgs = [] }
159
160-- | Make a simple named program.
161--
162-- By default we'll just search for it in the path and not try to find the
163-- version name. You can override these behaviours if necessary, eg:
164--
165-- > (simpleProgram "foo") { programFindLocation = ... , programFindVersion ... }
166--
167simpleProgram :: String -> Program
168simpleProgram name = Program {
169    programName         = name,
170    programFindLocation = \v p -> findProgramOnSearchPath v p name,
171    programFindVersion  = \_ _ -> return Nothing,
172    programPostConf     = \_ p -> return p,
173    programNormaliseArgs   = \_ _ -> id
174  }
175
176-- | Make a simple 'ConfiguredProgram'.
177--
178-- > simpleConfiguredProgram "foo" (FoundOnSystem path)
179--
180simpleConfiguredProgram :: String -> ProgramLocation -> ConfiguredProgram
181simpleConfiguredProgram name loc = ConfiguredProgram {
182     programId           = name,
183     programVersion      = Nothing,
184     programDefaultArgs  = [],
185     programOverrideArgs = [],
186     programOverrideEnv  = [],
187     programProperties   = Map.empty,
188     programLocation     = loc,
189     programMonitorFiles = [] -- did not look in any other locations
190  }
191