mach

A work-in-progress implementation of make(1)

git clone https://git.8pit.net/mach.git

  1module Mach.Main (run) where
  2
  3import Control.Exception (throwIO)
  4import Data.Maybe (fromMaybe)
  5import Mach.Error (MakeErr (..), TargetError (NoSuchTarget, ZeroTargetsDefined))
  6import Mach.Eval (MkDef, eval, firstTarget)
  7import Mach.Exec (maybeBuild, mkConfig, targetOrFile)
  8import Mach.Parser (cmdLine, parseMkFile)
  9import qualified Mach.Types as T
 10import Mach.Util (getEnvMarcos)
 11import Paths_mach (getDataFileName)
 12import System.Console.GetOpt
 13  ( ArgDescr (NoArg, ReqArg),
 14    ArgOrder (Permute),
 15    OptDescr (Option),
 16    getOpt,
 17    usageInfo,
 18  )
 19import System.Environment (lookupEnv)
 20import System.Exit (ExitCode (ExitFailure, ExitSuccess))
 21import System.IO (Handle)
 22
 23options :: [OptDescr T.Flag]
 24options =
 25  [ Option ['f'] [] (ReqArg T.Makefile "makefile") "Specify a different makefile",
 26    Option ['e'] [] (NoArg T.EnvOverwrite) "Overwrite macro assignments with environment variables",
 27    Option ['j'] [] (ReqArg T.Jobs "jobs") "Allow given amount of execution jobs at once",
 28    Option ['i'] [] (NoArg T.IgnoreAll) "Ignore exit status of executed commands",
 29    Option ['s'] [] (NoArg T.SilentAll) "Do not write command lines to stdout",
 30    Option ['k'] [] (NoArg T.ExecCont) "On error keep executing independent targets",
 31    Option ['n'] [] (NoArg T.DryRun) "Write commands to be executed to stdout",
 32    Option ['S'] [] (NoArg T.TermOnErr) "Terminate on error (the default)",
 33    Option ['r'] [] (NoArg T.NoBuiltin) "Do not use the builtin rules"
 34  ]
 35
 36makeOpts :: [String] -> IO ([T.Flag], [String])
 37makeOpts argv =
 38  case getOpt Permute options argv of
 39    (o, n, []) -> return (o, n)
 40    (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
 41  where
 42    header = "Usage: mach [-f makefile] [-j jobs] [target_name...]"
 43
 44------------------------------------------------------------------------
 45
 46makefile :: [T.Flag] -> T.MkFile -> T.MkFile -> FilePath -> IO MkDef
 47makefile my_flags extra environ path = do
 48  f <- parseMkFile path
 49
 50  -- If -e is specified, overwrite macro assignments with environment.
 51  let mk =
 52        if null [() | T.EnvOverwrite <- my_flags]
 53          then extra ++ environ ++ f
 54          else extra ++ f ++ environ
 55
 56  -- TODO: evaluate extra and environ once
 57  eval (mk)
 58
 59runMk :: Handle -> [T.Flag] -> T.MkFile -> T.MkFile -> [String] -> FilePath -> IO Bool
 60runMk handle my_flags extra environ my_targets path = do
 61  mk <- makefile my_flags extra environ path
 62  targets <-
 63    if null my_targets
 64      then (: []) <$> firstTarget' mk
 65      else pure my_targets
 66
 67  let conf = mkConfig mk handle my_flags
 68  (not . any (== False))
 69    <$> (mapM (targetOrFile' mk) targets >>= mapM (maybeBuild conf mk))
 70  where
 71    firstTarget' mk = case firstTarget mk of
 72      Nothing -> throwIO $ TargetErr ZeroTargetsDefined
 73      Just tg -> pure tg
 74
 75    targetOrFile' mk t = do
 76      tgt <- targetOrFile mk t
 77      case tgt of
 78        Nothing -> throwIO $ TargetErr (NoSuchTarget t)
 79        Just tg -> pure tg
 80
 81run :: Handle -> [String] -> IO ExitCode
 82run handle args = do
 83  (flagsCmd, remain) <- makeOpts args
 84  (vars, targets) <- cmdLine $ unwords remain
 85
 86  (flagsEnv, remainEnv) <- (fromMaybe "" <$> lookupEnv "MAKEFLAGS") >>= makeOpts . words
 87  (envMacros, _) <- cmdLine $ unwords remainEnv
 88
 89  environs <- getEnvMarcos
 90  builtins <- getDataFileName "share/builtin.mk" >>= parseMkFile
 91
 92  let my_flags = flagsCmd ++ flagsEnv
 93  let extra =
 94        if null [() | T.NoBuiltin <- my_flags]
 95          then builtins ++ vars ++ envMacros
 96          else vars ++ envMacros
 97
 98  res <- mapM (runMk handle my_flags extra environs targets) $
 99    case [f | T.Makefile f <- flagsCmd] of
100      [] -> ["Makefile"]
101      fs -> fs
102
103  pure $
104    if (any (== False) res)
105      then ExitFailure 1
106      else ExitSuccess