1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE RankNTypes #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  Distribution.Make
7-- Copyright   :  Martin Sjögren 2004
8-- License     :  BSD3
9--
10-- Maintainer  :  cabal-devel@haskell.org
11-- Portability :  portable
12--
13-- This is an alternative build system that delegates everything to the @make@
14-- program. All the commands just end up calling @make@ with appropriate
15-- arguments. The intention was to allow preexisting packages that used
16-- makefiles to be wrapped into Cabal packages. In practice essentially all
17-- such packages were converted over to the \"Simple\" build system instead.
18-- Consequently this module is not used much and it certainly only sees cursory
19-- maintenance and no testing. Perhaps at some point we should stop pretending
20-- that it works.
21--
22-- Uses the parsed command-line from "Distribution.Simple.Setup" in order to build
23-- Haskell tools using a back-end build system based on make. Obviously we
24-- assume that there is a configure script, and that after the ConfigCmd has
25-- been run, there is a Makefile. Further assumptions:
26--
27-- [ConfigCmd] We assume the configure script accepts
28--              @--with-hc@,
29--              @--with-hc-pkg@,
30--              @--prefix@,
31--              @--bindir@,
32--              @--libdir@,
33--              @--libexecdir@,
34--              @--datadir@.
35--
36-- [BuildCmd] We assume that the default Makefile target will build everything.
37--
38-- [InstallCmd] We assume there is an @install@ target. Note that we assume that
39-- this does *not* register the package!
40--
41-- [CopyCmd]    We assume there is a @copy@ target, and a variable @$(destdir)@.
42--              The @copy@ target should probably just invoke @make install@
43--              recursively (e.g. @$(MAKE) install prefix=$(destdir)\/$(prefix)
44--              bindir=$(destdir)\/$(bindir)@. The reason we can\'t invoke @make
45--              install@ directly here is that we don\'t know the value of @$(prefix)@.
46--
47-- [SDistCmd] We assume there is a @dist@ target.
48--
49-- [RegisterCmd] We assume there is a @register@ target and a variable @$(user)@.
50--
51-- [UnregisterCmd] We assume there is an @unregister@ target.
52--
53-- [HaddockCmd] We assume there is a @docs@ or @doc@ target.
54
55
56--                      copy :
57--                              $(MAKE) install prefix=$(destdir)/$(prefix) \
58--                                              bindir=$(destdir)/$(bindir) \
59
60module Distribution.Make (
61        module Distribution.Package,
62        License(..), Version,
63        defaultMain, defaultMainArgs
64  ) where
65
66import Prelude ()
67import Distribution.Compat.Prelude
68
69-- local
70import Distribution.Package
71import Distribution.Simple.Program
72import Distribution.Simple.Setup
73import Distribution.Simple.Command
74
75import Distribution.Simple.Utils
76
77import Distribution.License
78import Distribution.Version
79import Distribution.Pretty
80
81import System.Environment (getArgs, getProgName)
82
83defaultMain :: IO ()
84defaultMain = getArgs >>= defaultMainArgs
85
86defaultMainArgs :: [String] -> IO ()
87defaultMainArgs = defaultMainHelper
88
89defaultMainHelper :: [String] -> IO ()
90defaultMainHelper args =
91  case commandsRun (globalCommand commands) commands args of
92    CommandHelp   help                 -> printHelp help
93    CommandList   opts                 -> printOptionsList opts
94    CommandErrors errs                 -> printErrors errs
95    CommandReadyToGo (flags, commandParse)  ->
96      case commandParse of
97        _ | fromFlag (globalVersion flags)        -> printVersion
98          | fromFlag (globalNumericVersion flags) -> printNumericVersion
99        CommandHelp     help           -> printHelp help
100        CommandList     opts           -> printOptionsList opts
101        CommandErrors   errs           -> printErrors errs
102        CommandReadyToGo action        -> action
103
104  where
105    printHelp help = getProgName >>= putStr . help
106    printOptionsList = putStr . unlines
107    printErrors errs = do
108      putStr (intercalate "\n" errs)
109      exitWith (ExitFailure 1)
110    printNumericVersion = putStrLn $ prettyShow cabalVersion
111    printVersion        = putStrLn $ "Cabal library version "
112                                  ++ prettyShow cabalVersion
113
114    progs = defaultProgramDb
115    commands =
116      [configureCommand progs `commandAddAction` configureAction
117      ,buildCommand     progs `commandAddAction` buildAction
118      ,installCommand         `commandAddAction` installAction
119      ,copyCommand            `commandAddAction` copyAction
120      ,haddockCommand         `commandAddAction` haddockAction
121      ,cleanCommand           `commandAddAction` cleanAction
122      ,sdistCommand           `commandAddAction` sdistAction
123      ,registerCommand        `commandAddAction` registerAction
124      ,unregisterCommand      `commandAddAction` unregisterAction
125      ]
126
127configureAction :: ConfigFlags -> [String] -> IO ()
128configureAction flags args = do
129  noExtraFlags args
130  let verbosity = fromFlag (configVerbosity flags)
131  rawSystemExit verbosity "sh" $
132    "configure"
133    : configureArgs backwardsCompatHack flags
134  where backwardsCompatHack = True
135
136copyAction :: CopyFlags -> [String] -> IO ()
137copyAction flags args = do
138  noExtraFlags args
139  let destArgs = case fromFlag $ copyDest flags of
140        NoCopyDest      -> ["install"]
141        CopyTo path     -> ["copy", "destdir=" ++ path]
142        CopyToDb _      -> error "CopyToDb not supported via Make"
143
144  rawSystemExit (fromFlag $ copyVerbosity flags) "make" destArgs
145
146installAction :: InstallFlags -> [String] -> IO ()
147installAction flags args = do
148  noExtraFlags args
149  rawSystemExit (fromFlag $ installVerbosity flags) "make" ["install"]
150  rawSystemExit (fromFlag $ installVerbosity flags) "make" ["register"]
151
152haddockAction :: HaddockFlags -> [String] -> IO ()
153haddockAction flags args = do
154  noExtraFlags args
155  rawSystemExit (fromFlag $ haddockVerbosity flags) "make" ["docs"]
156    `catchIO` \_ ->
157    rawSystemExit (fromFlag $ haddockVerbosity flags) "make" ["doc"]
158
159buildAction :: BuildFlags -> [String] -> IO ()
160buildAction flags args = do
161  noExtraFlags args
162  rawSystemExit (fromFlag $ buildVerbosity flags) "make" []
163
164cleanAction :: CleanFlags -> [String] -> IO ()
165cleanAction flags args = do
166  noExtraFlags args
167  rawSystemExit (fromFlag $ cleanVerbosity flags) "make" ["clean"]
168
169sdistAction :: SDistFlags -> [String] -> IO ()
170sdistAction flags args = do
171  noExtraFlags args
172  rawSystemExit (fromFlag $ sDistVerbosity flags) "make" ["dist"]
173
174registerAction :: RegisterFlags -> [String] -> IO ()
175registerAction  flags args = do
176  noExtraFlags args
177  rawSystemExit (fromFlag $ regVerbosity flags) "make" ["register"]
178
179unregisterAction :: RegisterFlags -> [String] -> IO ()
180unregisterAction flags args = do
181  noExtraFlags args
182  rawSystemExit (fromFlag $ regVerbosity flags) "make" ["unregister"]
183