Cleanup
[barrelfish] / hake / Main.hs
1 {- 
2   Hake: a meta build system for Barrelfish
3
4   Copyright (c) 2009, 2015, ETH Zurich.
5   All rights reserved.
6   
7   This file is distributed under the terms in the attached LICENSE file.
8   If you do not find this file, copies can be found by writing to:
9   ETH Zurich D-INFK, Universit├Ątstasse 6, CH-8092 Zurich. Attn: Systems Group.
10 -}
11   
12 -- Asynchronous IO for walking directories
13 import Control.Concurrent.Async
14
15 import Control.Monad.Error
16
17 import Data.Dynamic
18 import Data.List
19 import Data.Maybe
20 import qualified Data.Set as S
21
22 import System.Directory
23 import System.Environment
24 import System.Exit
25 import System.FilePath
26 import System.IO
27
28 -- The GHC API.  We use the mtl-compatible version in order to use liftIO
29 -- within the GHC monad.
30 import GHC hiding (Target, Ghc, runGhc, FunBind, Match)
31 import GHC.Paths (libdir)
32 import Control.Monad.Ghc
33 import DynFlags (defaultFatalMessager, defaultFlushOut,
34                  xopt_set, ExtensionFlag (Opt_DeriveDataTypeable))
35
36 -- We parse and pretty-print Hakefiles.
37 import Language.Haskell.Exts
38
39 -- Hake components
40 import RuleDefs
41 import HakeTypes
42 import qualified Args
43 import qualified Config
44
45 data HakeError = HakeError String Int
46 instance Error HakeError
47 type HakeMonad = ErrorT HakeError IO
48
49 --
50 -- Command line options and parsing code
51 --
52 data Opts = Opts { opt_makefilename :: String,
53                    opt_installdir :: String,
54                    opt_sourcedir :: String,
55                    opt_bfsourcedir :: String,
56                    opt_abs_installdir :: String,
57                    opt_abs_sourcedir :: String,
58                    opt_abs_bfsourcedir :: String,
59                    opt_usage_error :: Bool,
60                    opt_architectures :: [String],
61                    opt_verbosity :: Integer
62                  }
63           deriving (Show,Eq)
64                    
65 parse_arguments :: [String] -> Opts
66 parse_arguments [] =
67   Opts { opt_makefilename = "Makefile",
68          opt_installdir = Config.install_dir,
69          opt_sourcedir = Config.source_dir,
70          opt_bfsourcedir = Config.source_dir,
71          opt_abs_installdir = "",
72          opt_abs_sourcedir = "",
73          opt_abs_bfsourcedir = "",
74          opt_usage_error = False, 
75          opt_architectures = [],
76          opt_verbosity = 1 }
77 parse_arguments ("--install-dir" : (s : t)) =
78   (parse_arguments t) { opt_installdir = s }
79 parse_arguments ("--source-dir" : s : t) =  
80   (parse_arguments t) { opt_sourcedir = s }
81 parse_arguments ("--bfsource-dir" : s : t) =  
82   (parse_arguments t) { opt_bfsourcedir = s }
83 parse_arguments ("--output-filename" : s : t) =
84   (parse_arguments t) { opt_makefilename = s }
85 parse_arguments ("--quiet" : t ) = 
86   (parse_arguments t) { opt_verbosity = 0 }
87 parse_arguments ("--verbose" : t ) = 
88   (parse_arguments t) { opt_verbosity = 2 }
89 parse_arguments ("--architecture" : a : t ) = 
90   let 
91     o2 = parse_arguments t
92     arches = (a : opt_architectures o2)
93   in
94     o2 { opt_architectures = arches }
95 parse_arguments _ = 
96   (parse_arguments []) { opt_usage_error = True }
97
98 usage :: String
99 usage = unlines [ "Usage: hake <options>",
100                   "   --source-dir <dir> (required)",
101                   "   --bfsource-dir <dir> (defaults to source dir)",
102                   "   --install-dir <dir> (defaults to source dir)",
103                   "   --quiet",
104                   "   --verbose"
105                 ]
106
107 -- Check the configuration options, returning an error string if they're
108 -- invalid.
109 configErrors :: Maybe String
110 configErrors
111     | unknownArchs /= [] =
112         Just ("unknown architecture(s) specified: " ++
113         (concat $ intersperse ", " unknownArchs))
114     | Config.architectures == [] =
115         Just "no architectures defined"
116     | Config.lazy_thc && not Config.use_fp =
117         Just "Config.use_fp must be true to use Config.lazy_thc."
118     | otherwise =
119         Nothing
120     where
121         unknownArchs = Config.architectures \\ Args.allArchitectures
122
123 -- Walk the source tree and build a complete list of pathnames, loading any
124 -- Hakefiles.
125 listFiles :: FilePath -> IO ([FilePath], [(FilePath, String)])
126 listFiles root = do
127     isdir <- doesDirectoryExist root
128     if isdir then do
129         children <- getDirectoryContents root
130         walkchildren children
131     else
132         return ([], [])
133     where
134         walkchildren :: [FilePath] -> IO ([FilePath], [(FilePath, String)])
135         walkchildren children = do
136             -- Walk the child directories in parallel.  This speeds things up
137             -- dramatically over NFS, with its high latency.
138             children_async <- mapM (async.walkchild) children
139             results <- mapM wait children_async
140             return $ joinResults results
141             where
142                 joinResults :: [([a],[b])] -> ([a],[b])
143                 joinResults [] = ([],[])
144                 joinResults ((as,bs):xs) =
145                     let (as',bs') = joinResults xs in
146                         (as ++ as', bs ++ bs')
147
148         walkchild :: FilePath -> IO ([FilePath], [(FilePath, String)])
149         walkchild child = do
150             if ignore child
151             then return ([], [])
152             else do
153                 (allfiles, hakefiles) <- listFiles (root </> child)
154                 hake <- maybeHake child
155                 return $ ((root </> child) : allfiles,
156                           hake ++ hakefiles)
157             where
158                 -- Load Hakfiles eagerly.  This amounts to <1MB for
159                 -- Barrelfish (2015).
160                 maybeHake "Hakefile" = do
161                     contents <- readFile (root </> child)
162                     return [(root </> child, contents)]
163                 maybeHake _ = return []
164
165         -- Don't descend into revision-control or build directories.
166         ignore :: FilePath -> Bool
167         ignore "."          = True
168         ignore ".."         = True
169         ignore "CMakeFiles" = True
170         ignore ".hg"        = True
171         ignore ".git"       = True
172         ignore "build"      = True
173         ignore _            = False
174
175 --
176 -- Hake parsing using the GHC API
177 --
178
179 -- We invoke GHC to parse the Hakefiles in a preconfigured environment,
180 -- to implement the Hake DSL.
181 evalHakeFiles :: Handle -> Opts -> [FilePath] -> [(FilePath, String)] ->
182                  IO (S.Set FilePath)
183 evalHakeFiles makefile o allfiles hakefiles =
184     defaultErrorHandler defaultFatalMessager defaultFlushOut $
185         runGhc (Just libdir) $
186         driveGhc makefile o allfiles hakefiles
187
188 -- This is the code that executes in the GHC monad.
189 driveGhc :: Handle -> Opts -> [FilePath] -> [(FilePath, String)] ->
190             Ghc (S.Set FilePath)
191 driveGhc makefile o allfiles hakefiles = do
192     -- Set the RTS flags
193     dflags <- getSessionDynFlags
194     let dflags' = foldl xopt_set dflags [ Opt_DeriveDataTypeable ]
195     _ <- setSessionDynFlags dflags'{
196         importPaths = module_paths,
197         hiDir = Just "./hake",
198         objectDir = Just "./hake"
199     }
200
201     -- Set compilation targets i.e. everything that needs to be built from
202     -- source (*.hs).
203     targets <- mapM (\m -> guessTarget m Nothing) source_modules
204     setTargets targets
205     load LoadAllTargets
206
207     -- Import both system and Hake modules.
208     setContext
209         ([IIDecl $ simpleImportDecl $ mkModuleName m |
210             m <- modules] ++
211          [IIDecl $ (simpleImportDecl $ mkModuleName m) {
212                 ideclQualified = True
213           } | m <- qualified_modules])
214
215     -- Emit Makefile sections corresponding to Hakefiles
216     buildSections hakefiles
217
218     where
219         module_paths = [ (opt_installdir o) </> "hake", ".", 
220                          (opt_bfsourcedir o) </> "hake" ]
221         source_modules = [ "HakeTypes", "RuleDefs", "Path", "Args", "Config" ]
222         modules = [ "Prelude", "HakeTypes", "RuleDefs", "Path", "Args" ]
223         qualified_modules = [ "Config", "Data.List" ]
224
225         -- Evaluate one Hakefile, and emit its Makefile section.  We collect
226         -- referenced directories as we go, to generate the 'directories'
227         -- rules later.
228         buildSections' :: (S.Set FilePath) -> [(FilePath, String)] ->
229                           Ghc (S.Set FilePath)
230         buildSections' dirs [] = return dirs
231         buildSections' dirs ((abs_hakepath, contents):hs) = do
232             let hakepath = makeRelative (opt_sourcedir o) abs_hakepath
233             rule <- evaluate hakepath contents
234             dirs' <- liftIO $ makefileSection makefile o hakepath rule
235             buildSections' (S.union dirs' dirs) hs
236
237         buildSections :: [(FilePath, String)] -> Ghc (S.Set FilePath)
238         buildSections hs = buildSections' S.empty hs
239
240         -- Evaluate a Hakefile, returning something of the form
241         -- Rule [...]
242         evaluate :: FilePath -> String -> Ghc HRule
243         evaluate hakepath hake_raw = do
244             case hake_parse of
245                 Left hake_expr -> do
246                     let hake_wrapped =
247                             prettyPrintWithMode (defaultMode {layout = PPNoLayout}) $
248                                 wrapHake hakepath hake_expr
249
250                     -- Evaluate in GHC
251                     val <- dynCompileExpr $ hake_wrapped ++ " :: [String] -> HRule"
252                     let rule = fromDyn val (\_ -> Error "failed")
253
254                     -- Path resolution
255                     let resolved_rule =
256                             resolvePaths o (takeDirectory hakepath)
257                                            (rule allfiles)
258                     return resolved_rule
259                 Right hake_error -> do
260                     return $ Error "failed"
261             where
262                 hake_parse = parseHake hakepath hake_raw
263
264 -- Parse a Hakefile, prior to wrapping it with Hake definitions
265 parseHake :: FilePath -> String -> Either Exp HakeError
266 parseHake filename contents =
267     case result of
268         ParseOk e -> Left e
269         ParseFailed loc str ->
270             Right $ HakeError (show loc ++ ": " ++ str) 2
271     where
272         result =
273             parseExpWithMode
274                 (defaultParseMode {
275                     parseFilename = filename,
276                     baseLanguage = Haskell2010 })
277                 contents
278
279 -- Split a Hake rule up by token type.  It's more efficient to do this
280 -- in a single pass, than to filter each as it's required.
281 data CompiledRule =
282     CompiledRule {
283         ruleOutputs    :: S.Set RuleToken,
284         ruleDepends    :: S.Set RuleToken,
285         rulePreDepends :: S.Set RuleToken,
286         ruleBody       :: [RuleToken],
287         ruleDirs       :: S.Set FilePath
288     }
289
290 compileRule :: [RuleToken] -> CompiledRule
291 compileRule [] = CompiledRule S.empty  S.empty  S.empty  []  S.empty
292 compileRule (t:ts) =
293     let CompiledRule outs deps predeps body dirs = compileRule ts
294         outs'    = if isOutput t then S.insert t outs else outs
295         deps'    = if isDependency t then S.insert t deps else deps
296         predeps' = if isPredependency t then S.insert t predeps else predeps
297         body'    = if inRule t then t:body else body
298         dirs'    = if isFileRef t &&
299                       inTree (frPath t) &&
300                       takeDirectory (frPath t) /= "."
301                    then S.insert (replaceFileName (frPath t) ".marker") dirs
302                    else dirs
303     in
304     CompiledRule outs' deps' predeps' body' dirs'
305     where
306         inTree :: FilePath -> Bool
307         inTree p =
308             case splitDirectories p of
309                 "..":_ -> False
310                 "/":_ -> False
311                 _ -> True
312
313 -- We wrap the AST of the parsed Hakefile to defind the 'find' and 'build'
314 -- primitives, and generate the correct expression type (HRule).  The result
315 -- is an unevaluted function [FilePath] -> HRule, that needs to be supplied
316 -- with the list of all files in the source directory.
317 wrapHake :: FilePath -> Exp -> Exp
318 wrapHake hakefile hake_exp =
319     Paren (
320     Lambda dummy_loc [PVar (Ident "allfiles")] (
321     Let (BDecls
322         [FunBind [Match -- This is 'find'
323             dummy_loc
324             (Ident "find")
325             [PVar (Ident "fn"), PVar (Ident "arg")]
326             Nothing
327             (UnGuardedRhs
328                 (Paren (App (App (App (Var (UnQual (Ident "fn")))
329                                       (Var (UnQual (Ident "allfiles"))))
330                                  (Lit (String hakefile)))
331                        (Var (UnQual (Ident "arg"))))))
332             (BDecls [])],
333
334         FunBind [Match
335             dummy_loc
336             (Ident "build") -- This is 'build'
337             [PVar (Ident "a")]
338             Nothing
339             (UnGuardedRhs
340                 (App (App (App (Paren (App (Var (UnQual (Ident "buildFunction")))
341                                            (Var (UnQual (Ident "a")))))
342                                (Var (UnQual (Ident "allfiles"))))
343                           (Lit (String hakefile)))
344                      (Var (UnQual (Ident "a")))))
345             (BDecls [])]
346         ])
347         (Paren (App (Con (UnQual (Ident "Rules")))
348                     hake_exp))
349     ))
350     where
351         dummy_loc = SrcLoc { srcFilename = "<hake internal>",
352                                 srcLine = 0, srcColumn = 0 }
353
354 --
355 -- Makefile generation
356 --
357
358 -- The Makefile header, generated once.
359 makefilePreamble :: Handle -> Opts -> [String] -> IO ()
360 makefilePreamble h opts args = 
361     mapM_ (hPutStrLn h)
362           ([ "# This Makefile is generated by Hake.  Do not edit!",
363              "# ",
364              "# Hake was invoked with the following command line args:" ] ++
365            [ "#        " ++ a | a <- args ] ++
366            [ "# ",
367              "SRCDIR=" ++ (opt_sourcedir opts),
368              "HAKE_ARCHS=" ++ (concat $ intersperse " " Config.architectures),
369              "include ./symbolic_targets.mk" ])
370
371 -- There a several valid top-level build directores, apart from the
372 -- architecture-specific one.
373 arch_list :: S.Set String
374 arch_list = S.fromList (Config.architectures ++
375                         ["", "src", "hake", "root", "tools", "docs"])
376
377 -- A rule is included if it applies to only "special" and configured
378 -- architectures.
379 allowedArchs :: [String] -> Bool
380 allowedArchs = all (\a -> a `S.member` arch_list)
381
382 -- The section corresponding to a Hakefile.  These routines all collect
383 -- and directories they see.
384 makefileSection :: Handle -> Opts -> FilePath -> HRule -> IO (S.Set FilePath)
385 makefileSection h opts hakepath rule = do
386     hPutStrLn h $ "# From: " ++ hakepath ++ "\n"
387     makefileRule h rule
388
389 makefileRule :: Handle -> HRule -> IO (S.Set FilePath)
390 makefileRule h (Error s) = do
391     hPutStrLn h $ "$(error " ++ s ++ ")\n"
392     return S.empty
393 makefileRule h (Rules rules) = do
394     dir_lists <- mapM (makefileRule h) rules
395     return $! S.unions dir_lists
396 makefileRule h (Include token) = do
397     when (allowedArchs [frArch token]) $
398         mapM_ (hPutStrLn h) [
399             "ifeq ($(MAKECMDGOALS),clean)",
400             "else ifeq ($(MAKECMDGOALS),rehake)",
401             "else ifeq ($(MAKECMDGOALS),Makefile)",
402             "else",
403             "include " ++ (formatToken token),
404             "endif",
405             "" ]
406     return S.empty
407 makefileRule h (HakeTypes.Rule tokens) =
408     if allowedArchs (map frArch tokens)
409         then makefileRuleInner h tokens False
410         else return S.empty
411 makefileRule h (Phony name double_colon tokens) = do
412     hPutStrLn h $ ".PHONY: " ++ name
413     makefileRuleInner h (Target "build" name : tokens) double_colon
414
415 printTokens :: Handle -> S.Set RuleToken -> IO ()
416 printTokens h tokens =
417     S.foldr (\t m -> hPutStr h (formatToken t) >> m) (return ()) tokens
418
419 printDirs :: Handle -> S.Set FilePath -> IO ()
420 printDirs h dirs =
421     S.foldr (\d m -> hPutStr h (d ++ " ") >> m) (return ()) dirs
422
423 makefileRuleInner :: Handle -> [RuleToken] -> Bool -> IO (S.Set FilePath)
424 makefileRuleInner h tokens double_colon = do
425     if S.null (ruleOutputs compiledRule)
426     then do
427         hPutStr h "# hake: omitted rule with no output: "
428         doBody
429     else do
430         printTokens h $ ruleOutputs compiledRule
431         if double_colon then hPutStr h ":: " else hPutStr h ": "
432         printTokens h $ ruleDepends compiledRule
433         printDirs h $ ruleDirs compiledRule
434         when (not (S.null (rulePreDepends compiledRule))) $ do
435             hPutStr h " | "
436             printTokens h $ rulePreDepends compiledRule
437         hPutStrLn h ""
438         doBody
439     where
440         compiledRule = compileRule tokens
441
442         doBody :: IO (S.Set FilePath)
443         doBody = do
444             when (ruleBody compiledRule /= []) $ do
445                 hPutStr h "\t"
446                 mapM_ (hPutStr h . formatToken) $ ruleBody compiledRule
447             hPutStrLn h "\n"
448             return $ ruleDirs compiledRule
449
450 --
451 -- Functions to resolve path names in rules. 
452 --
453 -- Absolute paths are interpreted relative to one of the three trees: source,
454 -- build or install.  Relative paths are interpreted relative to the directory
455 -- containing the Hakefile that referenced them, within one of the above tree.
456 -- Both build and install trees are divided by architecture, while the source
457 -- tree is not.  All paths are output relative to the build directory.
458 --
459 -- For example, if we are building for architecture 'x86_64', with build tree
460 -- '/home/user/barrelfish/build' and build tree '/home/user/barrelfish'
461 -- (relative path '../', and we are compiling a Hakefile at 'apps/init/Hakefile'
462 -- (relative path  '../apps/init/Hakefile'), we would resolve as follows:
463 --
464 --   In SourceTree "../apps/init" "x86_64" "main.c"
465 --      -> "../apps/init/main.c"
466 --   In BuildTree "../apps/init" "x86_64" "/include/generated.h"
467 --      -> "./x86_64/include/generated.h"
468 --   Out BuildTree "../apps/init" "root" "/doc/manual.pdf"
469 --      -> "./doc/manual.pdf"
470 --
471 -- Note that the 'root' architecture is special, and always refers to the root
472 -- of the relevant tree.
473
474 -- Recurse through the Hake AST
475 resolvePaths :: Opts -> FilePath -> HRule -> HRule
476 resolvePaths o hakepath (Rules hrules)
477     = Rules $ map (resolvePaths o hakepath) hrules
478 resolvePaths o hakepath (HakeTypes.Rule tokens)
479     = HakeTypes.Rule $ map (resolveTokenPath o hakepath) tokens
480 resolvePaths o hakepath (Include token)
481     = Include $ resolveTokenPath o hakepath token
482 resolvePaths o hakepath (Error s)
483     = Error s
484 resolvePaths o hakepath (Phony name dbl tokens)
485     = Phony name dbl $ map (resolveTokenPath o hakepath) tokens
486
487 -- Now resolve at the level of individual rule tokens.  At this level,
488 -- we need to take into account the tree (source, build, or install).
489 resolveTokenPath :: Opts -> FilePath -> RuleToken -> RuleToken
490 -- An input token specifies which tree it refers to.
491 resolveTokenPath o hakepath (In tree arch path) = 
492     (In tree arch (treePath o tree arch path hakepath))
493 -- An output token implicitly refers to the build tree.
494 resolveTokenPath o hakepath (Out arch path) = 
495     (Out arch (treePath o BuildTree arch path hakepath))
496 -- A dependency token specifies which tree it refers to.
497 resolveTokenPath o hakepath (Dep tree arch path) = 
498     (Dep tree arch (treePath o tree arch path hakepath))
499 -- A non-dependency token specifies which tree it refers to.
500 resolveTokenPath o hakepath (NoDep tree arch path) = 
501     (NoDep tree arch (treePath o tree arch path hakepath))
502 -- A pre-dependency token specifies which tree it refers to.
503 resolveTokenPath o hakepath (PreDep tree arch path) = 
504     (PreDep tree arch (treePath o tree arch path hakepath))
505 -- An target token implicitly refers to the build tree.
506 resolveTokenPath o hakepath (Target arch path) = 
507     (Target arch (treePath o BuildTree arch path hakepath))
508 -- Other tokens don't contain paths to resolve.
509 resolveTokenPath _ _ token = token
510
511 -- Now we get down to the nitty gritty.  We have, in order:
512 --   o:        The options in force
513 --   tree:     The tree (source, build, or install)
514 --   arch:     The architecture (e.g. armv7)
515 --   path:     The pathname we want to resolve
516 --   hakepath: The directory containing the Hakefile
517 -- If the tree is SrcTree or the architecture is "root", everything
518 -- is relative to the top-level directory for that tree.  Otherwise,
519 -- it's relative to the top-level directory plus the architecture.
520 treePath :: Opts -> TreeRef -> FilePath -> FilePath -> FilePath -> FilePath
521 -- The architecture 'root' is special.
522 treePath o SrcTree "root" path hakepath = 
523     relPath (opt_sourcedir o) path hakepath
524 treePath o BuildTree "root" path hakepath = 
525     relPath "." path hakepath
526 treePath o InstallTree "root" path hakepath = 
527     relPath (opt_installdir o) path hakepath
528 -- Source-tree paths don't get an architecture.
529 treePath o SrcTree arch path hakepath =
530     relPath (opt_sourcedir o) path hakepath
531 treePath o BuildTree arch path hakepath =
532     relPath ("." </> arch) path hakepath
533 treePath o InstallTree arch path hakepath =
534     relPath (opt_installdir o </> arch) path hakepath
535
536 -- First evaluate the given path 'path', relative to the Hakefile directory
537 -- 'hakepath'.  If 'path' is absolute (i.e. begins with a /), it is unchanged.
538 -- Otherwise it is appended to 'hakepath'.  We then treat this as a relative
539 -- path (by removing any initial /), and append it to the relevant tree root
540 -- (which may or may not have an architecture path appended already).
541 relPath treeroot path hakepath =
542     treeroot </> stripSlash (hakepath </> path)
543
544 -- Strip any leading slash from the filename.  This is much faster than
545 -- 'makeRelative "/"'.
546 stripSlash :: FilePath -> FilePath
547 stripSlash ('/':cs) = cs
548 stripSlash cs = cs
549
550 -- Emit the rule to rebuild the Hakefile.
551 makeHakeDeps :: Handle -> Opts -> [String] -> IO ()
552 makeHakeDeps h o l = do
553     makefileRule h rule
554     hPutStrLn h ".DELETE_ON_ERROR:\n" -- this applies to following targets.
555     where
556         hake = resolveTokenPath o "" (In InstallTree "root" "/hake/hake")
557         makefile = resolveTokenPath o "/" (Out "root" (opt_makefilename o))
558         rule = HakeTypes.Rule
559                     ( [ hake, 
560                         Str "--source-dir", Str (opt_sourcedir o),
561                         Str "--install-dir", Str (opt_installdir o),
562                         Str "--output-filename", makefile
563                       ] ++
564                       [ Dep SrcTree "root" h | h <- l ]
565                     )
566
567 -- Emit the rules to create the build directories
568 makeDirectories :: Handle -> S.Set FilePath -> IO ()
569 makeDirectories h dirs = do
570     hPutStrLn h "# Directories follow"
571     mapM_ (makeDir h) (S.toList (S.delete ("." </> ".marker") dirs))
572
573 makeDir :: Handle -> FilePath -> IO ()
574 makeDir h dir = do
575     hPutStrLn h $ "hake_dirs: " ++ dir ++ "\n"
576     hPutStrLn h $ dir ++ ":"
577     hPutStrLn h $ "\tmkdir -p " ++ (takeDirectory dir)
578     hPutStrLn h $ "\ttouch " ++ dir
579     hPutStrLn h ""
580
581 --
582 -- The top level
583 --
584
585 body :: HakeMonad ()
586 body =  do
587     -- Parse arguments; architectures default to config file
588     args <- liftIO $ System.Environment.getArgs
589     let o1 = parse_arguments args
590         al = if opt_architectures o1 == [] 
591              then Config.architectures 
592              else opt_architectures o1
593         opts' = o1 { opt_architectures = al }
594
595     when (opt_usage_error opts') $
596         throwError (HakeError usage 1)
597
598     -- Check configuration settings.
599     -- This is currently known at compile time, but might not always be!
600     when (isJust configErrors) $
601         throwError (HakeError ("Error in configuration: " ++
602                                (fromJust configErrors)) 2)
603
604     -- Canonicalise directories
605     abs_sourcedir   <- liftIO $ canonicalizePath $ opt_sourcedir opts'
606     abs_bfsourcedir <- liftIO $ canonicalizePath $ opt_bfsourcedir opts'
607     abs_installdir  <- liftIO $ canonicalizePath $ opt_installdir opts'
608     let opts = opts' { opt_abs_sourcedir   = abs_sourcedir,
609                        opt_abs_bfsourcedir = abs_bfsourcedir,
610                        opt_abs_installdir  = abs_installdir }
611
612     liftIO $ putStrLn ("Source directory: " ++ opt_sourcedir opts ++
613                        " (" ++ opt_abs_sourcedir opts ++ ")")
614     liftIO $ putStrLn ("BF Source directory: " ++ opt_bfsourcedir opts ++
615                        " (" ++ opt_abs_bfsourcedir opts ++ ")")
616     liftIO $ putStrLn ("Install directory: " ++ opt_installdir opts ++
617                        " (" ++ opt_abs_installdir opts ++ ")")
618
619     -- Find Hakefiles
620     liftIO $ putStrLn "Reading directory tree..."
621     (allfiles, hakefiles) <- liftIO $ listFiles (opt_sourcedir opts)
622     let relfiles = map (makeRelative $ opt_sourcedir opts') allfiles
623
624     -- Open the Makefile and write the preamble
625     liftIO $ putStrLn $ "Opening " ++ (opt_makefilename opts)
626     makefile <- liftIO $ openFile(opt_makefilename opts) WriteMode
627     liftIO $ makefilePreamble makefile opts args
628     liftIO $ makeHakeDeps makefile opts $ map fst hakefiles
629
630     -- Evaluate Hakefiles
631     liftIO $ putStrLn $ "Evaluating " ++ show (length hakefiles) ++
632                         " Hakefiles..."
633     dirs <- liftIO $ evalHakeFiles makefile opts relfiles hakefiles
634
635     -- Emit directory rules
636     liftIO $ putStrLn $ "Generating build directory dependencies..."
637     liftIO $ makeDirectories makefile dirs
638
639     return ()
640
641 main :: IO () 
642 main = do
643     r <- runErrorT $ body `catchError` handleFailure
644     exitWith ExitSuccess
645     where
646         handleFailure (HakeError str n) = do
647             liftIO $ putStrLn str
648             liftIO $ exitWith (ExitFailure n)