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.Compat.Exception
71import Distribution.Package
72import Distribution.Simple.Program
73import Distribution.Simple.Setup
74import Distribution.Simple.Command
75
76import Distribution.Simple.Utils
77
78import Distribution.License
79import Distribution.Version
80import Distribution.Pretty
81
82import System.Environment (getArgs, getProgName)
83import System.Exit
84
85defaultMain :: IO ()
86defaultMain = getArgs >>= defaultMainArgs
87
88defaultMainArgs :: [String] -> IO ()
89defaultMainArgs = defaultMainHelper
90
91defaultMainHelper :: [String] -> IO ()
92defaultMainHelper args =
93  case commandsRun (globalCommand commands) commands args of
94    CommandHelp   help                 -> printHelp help
95    CommandList   opts                 -> printOptionsList opts
96    CommandErrors errs                 -> printErrors errs
97    CommandReadyToGo (flags, commandParse)  ->
98      case commandParse of
99        _ | fromFlag (globalVersion flags)        -> printVersion
100          | fromFlag (globalNumericVersion flags) -> printNumericVersion
101        CommandHelp     help           -> printHelp help
102        CommandList     opts           -> printOptionsList opts
103        CommandErrors   errs           -> printErrors errs
104        CommandReadyToGo action        -> action
105
106  where
107    printHelp help = getProgName >>= putStr . help
108    printOptionsList = putStr . unlines
109    printErrors errs = do
110      putStr (intercalate "\n" errs)
111      exitWith (ExitFailure 1)
112    printNumericVersion = putStrLn $ prettyShow cabalVersion
113    printVersion        = putStrLn $ "Cabal library version "
114                                  ++ prettyShow cabalVersion
115
116    progs = defaultProgramDb
117    commands =
118      [configureCommand progs `commandAddAction` configureAction
119      ,buildCommand     progs `commandAddAction` buildAction
120      ,installCommand         `commandAddAction` installAction
121      ,copyCommand            `commandAddAction` copyAction
122      ,haddockCommand         `commandAddAction` haddockAction
123      ,cleanCommand           `commandAddAction` cleanAction
124      ,sdistCommand           `commandAddAction` sdistAction
125      ,registerCommand        `commandAddAction` registerAction
126      ,unregisterCommand      `commandAddAction` unregisterAction
127      ]
128
129configureAction :: ConfigFlags -> [String] -> IO ()
130configureAction flags args = do
131  noExtraFlags args
132  let verbosity = fromFlag (configVerbosity flags)
133  rawSystemExit verbosity "sh" $
134    "configure"
135    : configureArgs backwardsCompatHack flags
136  where backwardsCompatHack = True
137
138copyAction :: CopyFlags -> [String] -> IO ()
139copyAction flags args = do
140  noExtraFlags args
141  let destArgs = case fromFlag $ copyDest flags of
142        NoCopyDest      -> ["install"]
143        CopyTo path     -> ["copy", "destdir=" ++ path]
144        CopyToDb _      -> error "CopyToDb not supported via Make"
145
146  rawSystemExit (fromFlag $ copyVerbosity flags) "make" destArgs
147
148installAction :: InstallFlags -> [String] -> IO ()
149installAction flags args = do
150  noExtraFlags args
151  rawSystemExit (fromFlag $ installVerbosity flags) "make" ["install"]
152  rawSystemExit (fromFlag $ installVerbosity flags) "make" ["register"]
153
154haddockAction :: HaddockFlags -> [String] -> IO ()
155haddockAction flags args = do
156  noExtraFlags args
157  rawSystemExit (fromFlag $ haddockVerbosity flags) "make" ["docs"]
158    `catchIO` \_ ->
159    rawSystemExit (fromFlag $ haddockVerbosity flags) "make" ["doc"]
160
161buildAction :: BuildFlags -> [String] -> IO ()
162buildAction flags args = do
163  noExtraFlags args
164  rawSystemExit (fromFlag $ buildVerbosity flags) "make" []
165
166cleanAction :: CleanFlags -> [String] -> IO ()
167cleanAction flags args = do
168  noExtraFlags args
169  rawSystemExit (fromFlag $ cleanVerbosity flags) "make" ["clean"]
170
171sdistAction :: SDistFlags -> [String] -> IO ()
172sdistAction flags args = do
173  noExtraFlags args
174  rawSystemExit (fromFlag $ sDistVerbosity flags) "make" ["dist"]
175
176registerAction :: RegisterFlags -> [String] -> IO ()
177registerAction  flags args = do
178  noExtraFlags args
179  rawSystemExit (fromFlag $ regVerbosity flags) "make" ["register"]
180
181unregisterAction :: RegisterFlags -> [String] -> IO ()
182unregisterAction flags args = do
183  noExtraFlags args
184  rawSystemExit (fromFlag $ regVerbosity flags) "make" ["unregister"]
185