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