Add quiet option for devalloc startup

It would be good to have this as a general logging config, but I'm not sure how
to do that. I probably need a logging monad or something.

1 files changed, 11 insertions, 10 deletions

diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 2333cac..0442ae2 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -439,7 +439,7 @@ help =
 devalloc
 
 Usage:
-  devalloc
+  devalloc [--quiet]
   devalloc test
 |]
 
@@ -450,17 +450,18 @@ move args =
     shutdown
     run
 
-startup :: IO (Config, Application, Acid.AcidState Keep)
-startup = do
+startup :: Bool -> IO (Config, Application, Acid.AcidState Keep)
+startup quiet = do
   cfg <- Envy.decodeWithDefaults Envy.defConfig
   oAuthArgs <- Envy.decodeWithDefaults Envy.defConfig
   kp <- Acid.openLocalStateFrom (keep cfg) init :: IO (Acid.AcidState Keep)
   jwk <- Auth.generateKey
-  Log.info ["@", "devalloc"] >> Log.br
-  Log.info ["area", show <| area cfg] >> Log.br
-  Log.info ["port", show <| port cfg] >> Log.br
-  Log.info ["depo", Text.pack <| depo cfg] >> Log.br
-  Log.info ["keep", Text.pack <| keep cfg] >> Log.br
+  unless quiet <| do
+    Log.info ["@", "devalloc"] >> Log.br
+    Log.info ["area", show <| area cfg] >> Log.br
+    Log.info ["port", show <| port cfg] >> Log.br
+    Log.info ["depo", Text.pack <| depo cfg] >> Log.br
+    Log.info ["keep", Text.pack <| keep cfg] >> Log.br
   let jwtCfg = Auth.defaultJWTSettings jwk
   let cooks = case area cfg of
         Test -> testCookieSettings
@@ -1401,9 +1402,9 @@ fetchBareRepo depo url =
     >> pure worktree
   where
     fetchOrClone True =
-      Process.callProcess "git" ["--git-dir", worktree, "fetch", "origin"]
+      Process.callProcess "git" ["--git-dir", worktree, "fetch", "--quiet", "origin"]
     fetchOrClone False =
-      Process.callProcess "git" ["clone", "--bare", "--", Text.unpack url, worktree]
+      Process.callProcess "git" ["clone", "--quiet", "--bare", "--", Text.unpack url, worktree]
     removeScheme :: Text -> FilePath
     removeScheme u = Text.unpack <. Text.dropWhile (== '/') <. snd <| Text.breakOn "//" u
     worktree = depo </> removeScheme url <.> "git"