From dbdf4da2576f889544a33ce0bad4b8a5ff3eca87 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Thu, 21 Sep 2023 16:59:15 -0400
Subject: Add a 10-minute timeout for all builds

A build should never take more than 10 minutes. If it does, then force the
programmer to make stuff faster. This should be a forcing function to either
delete unneeded code, or improve the build system.
---
 Biz/Bild.hs             | 25 +++++++++++++++++++++----
 Biz/Cli.hs              |  7 ++++++-
 Biz/Dragons/Analysis.hs | 10 ++++++----
 3 files changed, 33 insertions(+), 9 deletions(-)

(limited to 'Biz')

diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 22d3882..1e0422a 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -147,6 +147,7 @@ import System.FilePath (replaceExtension, (</>))
 import qualified System.IO as IO
 import System.IO.Unsafe (unsafePerformIO)
 import qualified System.Process as Process
+import qualified System.Timeout as Timeout
 import qualified Text.Regex.Applicative as Regex
 
 main :: IO ()
@@ -204,7 +205,22 @@ move args =
         /> Map.filter (namespace .> isBuildableNs)
         +> printOrBuild
         +> exitSummary
+        -- convert minutes to microseconds
+        |> Timeout.timeout (minutes * 60_000_000)
+        +> \case
+          Nothing ->
+            Log.wipe
+              >> Log.fail ["bild", "timeout after " <> tshow minutes <> " minutes"]
+              >> exitWith (ExitFailure 124)
+          Just _ ->
+            pure ()
   where
+    minutes =
+      Cli.getArgWithDefault args (Cli.longOption "time")
+        |> readMaybe
+        |> \case
+          Nothing -> panic "could not read --time argument"
+          Just n -> n
     printOrBuild :: Analysis -> IO [ExitCode]
     printOrBuild targets
       | args `Cli.has` Cli.longOption "json" =
@@ -230,10 +246,11 @@ Usage:
   bild [options] <target>...
 
 Options:
-  --test      Run tests on a target after building
-  --loud      Show all output from compiler
-  --json      Print the build plan as JSON, don't build
-  -h, --help  Print this info
+  --test, -t   Run tests on a target after building
+  --loud, -l   Show all output from compiler
+  --json, -j   Print the build plan as JSON, don't build
+  --time N     Set timeout to N minutes [default: 10]
+  --help, -h   Print this info
 |]
 
 exitSummary :: [Exit.ExitCode] -> IO ()
diff --git a/Biz/Cli.hs b/Biz/Cli.hs
index b3c7583..819fdf1 100644
--- a/Biz/Cli.hs
+++ b/Biz/Cli.hs
@@ -10,7 +10,7 @@ module Biz.Cli
     Docopt.docopt,
     Docopt.getAllArgs,
     Docopt.getArg,
-    Docopt.getArgWithDefault,
+    getArgWithDefault,
     Docopt.longOption,
     Docopt.shortOption,
     Docopt.command,
@@ -44,3 +44,8 @@ main Plan {..} =
 
 has :: Docopt.Arguments -> Docopt.Option -> Bool
 has = Docopt.isPresent
+
+-- | This ignores the second argument because the default should come from the
+-- USAGE text with [default: x].
+getArgWithDefault :: Docopt.Arguments -> Docopt.Option -> String
+getArgWithDefault args = Docopt.getArgWithDefault args ""
diff --git a/Biz/Dragons/Analysis.hs b/Biz/Dragons/Analysis.hs
index 8641a6d..c27eebb 100644
--- a/Biz/Dragons/Analysis.hs
+++ b/Biz/Dragons/Analysis.hs
@@ -43,8 +43,8 @@ move :: Cli.Arguments -> IO ()
 move args = gitDir +> run authors /> Aeson.encode +> putStrLn
   where
     gitDir =
-      Cli.argument "git-dir"
-        |> Cli.getArgWithDefault args ".git"
+      Cli.longOption "git-dir"
+        |> Cli.getArgWithDefault args
         |> Directory.makeAbsolute
     authors =
       -- i think this is not working? do i need optparse-applicative?
@@ -66,10 +66,12 @@ dragons-analyze
 
 Usage:
   dragons-analyze test
-  dragons-analyze [--author=<email>]... <git-dir>
+  dragons-analyze [--author=<email>]...
 
 Options:
-  -a, --author  List of active authors' emails.
+  --git-dir     The git repo to analyze [default: ./.git]
+  -a, --author  List of active authors' emails, may be specified
+                multiple times
 |]
 
 newtype Commit = Sha Text
-- 
cgit v1.2.3