1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE RankNTypes #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  Distribution.Simple.UserHooks
7-- Copyright   :  Isaac Jones 2003-2005
8-- License     :  BSD3
9--
10-- Maintainer  :  cabal-devel@haskell.org
11-- Portability :  portable
12--
13-- This defines the API that @Setup.hs@ scripts can use to customise the way
14-- the build works. This module just defines the 'UserHooks' type. The
15-- predefined sets of hooks that implement the @Simple@, @Make@ and @Configure@
16-- build systems are defined in "Distribution.Simple". The 'UserHooks' is a big
17-- record of functions. There are 3 for each action, a pre, post and the action
18-- itself. There are few other miscellaneous hooks, ones to extend the set of
19-- programs and preprocessors and one to override the function used to read the
20-- @.cabal@ file.
21--
22-- This hooks type is widely agreed to not be the right solution. Partly this
23-- is because changes to it usually break custom @Setup.hs@ files and yet many
24-- internal code changes do require changes to the hooks. For example we cannot
25-- pass any extra parameters to most of the functions that implement the
26-- various phases because it would involve changing the types of the
27-- corresponding hook. At some point it will have to be replaced.
28
29module Distribution.Simple.UserHooks (
30        UserHooks(..), Args,
31        emptyUserHooks,
32  ) where
33
34import Prelude ()
35import Distribution.Compat.Prelude
36
37import Distribution.PackageDescription
38import Distribution.Simple.Program
39import Distribution.Simple.Command
40import Distribution.Simple.PreProcess
41import Distribution.Simple.Setup
42import Distribution.Simple.LocalBuildInfo
43
44type Args = [String]
45
46-- | Hooks allow authors to add specific functionality before and after a
47-- command is run, and also to specify additional preprocessors.
48--
49-- * WARNING: The hooks interface is under rather constant flux as we try to
50-- understand users needs. Setup files that depend on this interface may
51-- break in future releases.
52data UserHooks = UserHooks {
53
54    -- | Read the description file
55    readDesc :: IO (Maybe GenericPackageDescription),
56    -- | Custom preprocessors in addition to and overriding 'knownSuffixHandlers'.
57    hookedPreProcessors :: [ PPSuffixHandler ],
58    -- | These programs are detected at configure time.  Arguments for them are
59    -- added to the configure command.
60    hookedPrograms :: [Program],
61
62    -- |Hook to run before configure command
63    preConf  :: Args -> ConfigFlags -> IO HookedBuildInfo,
64    -- |Over-ride this hook to get different behavior during configure.
65    confHook :: (GenericPackageDescription, HookedBuildInfo)
66            -> ConfigFlags -> IO LocalBuildInfo,
67    -- |Hook to run after configure command
68    postConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO (),
69
70    -- |Hook to run before build command.  Second arg indicates verbosity level.
71    preBuild  :: Args -> BuildFlags -> IO HookedBuildInfo,
72
73    -- |Over-ride this hook to get different behavior during build.
74    buildHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO (),
75    -- |Hook to run after build command.  Second arg indicates verbosity level.
76    postBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO (),
77
78    -- |Hook to run before repl command.  Second arg indicates verbosity level.
79    preRepl  :: Args -> ReplFlags -> IO HookedBuildInfo,
80    -- |Over-ride this hook to get different behavior during interpretation.
81    replHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO (),
82    -- |Hook to run after repl command.  Second arg indicates verbosity level.
83    postRepl :: Args -> ReplFlags -> PackageDescription -> LocalBuildInfo -> IO (),
84
85    -- |Hook to run before clean command.  Second arg indicates verbosity level.
86    preClean  :: Args -> CleanFlags -> IO HookedBuildInfo,
87    -- |Over-ride this hook to get different behavior during clean.
88    cleanHook :: PackageDescription -> () -> UserHooks -> CleanFlags -> IO (),
89    -- |Hook to run after clean command.  Second arg indicates verbosity level.
90    postClean :: Args -> CleanFlags -> PackageDescription -> () -> IO (),
91
92    -- |Hook to run before copy command
93    preCopy  :: Args -> CopyFlags -> IO HookedBuildInfo,
94    -- |Over-ride this hook to get different behavior during copy.
95    copyHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO (),
96    -- |Hook to run after copy command
97    postCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO (),
98
99    -- |Hook to run before install command
100    preInst  :: Args -> InstallFlags -> IO HookedBuildInfo,
101
102    -- |Over-ride this hook to get different behavior during install.
103    instHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO (),
104    -- |Hook to run after install command.  postInst should be run
105    -- on the target, not on the build machine.
106    postInst :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO (),
107
108    -- |Hook to run before register command
109    preReg  :: Args -> RegisterFlags -> IO HookedBuildInfo,
110    -- |Over-ride this hook to get different behavior during registration.
111    regHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO (),
112    -- |Hook to run after register command
113    postReg :: Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO (),
114
115    -- |Hook to run before unregister command
116    preUnreg  :: Args -> RegisterFlags -> IO HookedBuildInfo,
117    -- |Over-ride this hook to get different behavior during unregistration.
118    unregHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO (),
119    -- |Hook to run after unregister command
120    postUnreg :: Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO (),
121
122    -- |Hook to run before hscolour command.  Second arg indicates verbosity level.
123    preHscolour  :: Args -> HscolourFlags -> IO HookedBuildInfo,
124    -- |Over-ride this hook to get different behavior during hscolour.
125    hscolourHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> HscolourFlags -> IO (),
126    -- |Hook to run after hscolour command.  Second arg indicates verbosity level.
127    postHscolour :: Args -> HscolourFlags -> PackageDescription -> LocalBuildInfo -> IO (),
128
129    -- |Hook to run before doctest command.  Second arg indicates verbosity level.
130    preDoctest  :: Args -> DoctestFlags -> IO HookedBuildInfo,
131    -- |Over-ride this hook to get different behavior during doctest.
132    doctestHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> DoctestFlags -> IO (),
133    -- |Hook to run after doctest command.  Second arg indicates verbosity level.
134    postDoctest :: Args -> DoctestFlags -> PackageDescription -> LocalBuildInfo -> IO (),
135
136    -- |Hook to run before haddock command.  Second arg indicates verbosity level.
137    preHaddock  :: Args -> HaddockFlags -> IO HookedBuildInfo,
138    -- |Over-ride this hook to get different behavior during haddock.
139    haddockHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO (),
140    -- |Hook to run after haddock command.  Second arg indicates verbosity level.
141    postHaddock :: Args -> HaddockFlags -> PackageDescription -> LocalBuildInfo -> IO (),
142
143    -- |Hook to run before test command.
144    preTest :: Args -> TestFlags -> IO HookedBuildInfo,
145    -- |Over-ride this hook to get different behavior during test.
146    testHook :: Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO (),
147    -- |Hook to run after test command.
148    postTest :: Args -> TestFlags -> PackageDescription -> LocalBuildInfo -> IO (),
149
150    -- |Hook to run before bench command.
151    preBench :: Args -> BenchmarkFlags -> IO HookedBuildInfo,
152    -- |Over-ride this hook to get different behavior during bench.
153    benchHook :: Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> BenchmarkFlags -> IO (),
154    -- |Hook to run after bench command.
155    postBench :: Args -> BenchmarkFlags -> PackageDescription -> LocalBuildInfo -> IO ()
156  }
157
158-- |Empty 'UserHooks' which do nothing.
159emptyUserHooks :: UserHooks
160emptyUserHooks
161  = UserHooks {
162      readDesc  = return Nothing,
163      hookedPreProcessors = [],
164      hookedPrograms      = [],
165      preConf   = rn',
166      confHook  = (\_ _ -> return (error "No local build info generated during configure. Over-ride empty configure hook.")),
167      postConf  = ru,
168      preBuild  = rn',
169      buildHook = ru,
170      postBuild = ru,
171      preRepl   = \_ _ -> return emptyHookedBuildInfo,
172      replHook  = \_ _ _ _ _ -> return (),
173      postRepl  = ru,
174      preClean  = rn,
175      cleanHook = ru,
176      postClean = ru,
177      preCopy   = rn',
178      copyHook  = ru,
179      postCopy  = ru,
180      preInst   = rn,
181      instHook  = ru,
182      postInst  = ru,
183      preReg    = rn',
184      regHook   = ru,
185      postReg   = ru,
186      preUnreg  = rn,
187      unregHook = ru,
188      postUnreg = ru,
189      preHscolour  = rn,
190      hscolourHook = ru,
191      postHscolour = ru,
192      preDoctest   = rn,
193      doctestHook  = ru,
194      postDoctest  = ru,
195      preHaddock   = rn',
196      haddockHook  = ru,
197      postHaddock  = ru,
198      preTest  = rn',
199      testHook = \_ -> ru,
200      postTest = ru,
201      preBench = rn',
202      benchHook = \_ -> ru,
203      postBench = ru
204    }
205    where rn  args _ = noExtraFlags args >> return emptyHookedBuildInfo
206          rn' _    _ = return emptyHookedBuildInfo
207          ru _ _ _ _ = return ()
208