Global shell settings

.gitignore

@@ -14,3 +14,4 @@ hermit-shell.wiki
 .cabal-sandbox
 cabal.sandbox.config
 tests/dump/*.dump
+tags

src/HERMIT/API/Types.hs

@@ -6,6 +6,8 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
 module HERMIT.API.Types where
 
 import Control.Applicative
@@ -25,6 +27,8 @@ import HERMIT.PrettyPrinter.Common
 import HERMIT.RemoteShell.Orphanage
 
 import Data.Coerce
+import Data.IORef
+import System.IO.Unsafe (unsafePerformIO)
 
 ------------------------------------------------------------------------
 
@@ -89,15 +93,27 @@ proxyToJSON Proxy = String $ pack $ show $ typeOf (undefined :: a)
 class FromJSON a => Response a where
   printResponse :: a -> IO ()
 
+quietModeM :: IORef Bool
+quietModeM = unsafePerformIO (newIORef False)
+{-# NOINLINE quietModeM #-}
+
 instance Response () where
   printResponse () = return ()
 
 instance Response String where
-  printResponse = print
+  printResponse str = do
+    quietMode <- readIORef quietModeM
+    if quietMode
+      then return ()
+      else print str
 
 instance Response DocH where
-  printResponse doc =
-      let (ASCII x) = renderCode def doc in
+  printResponse doc = do
+    quietMode <- readIORef quietModeM
+    if quietMode
+      then return ()
+      else
+        let (ASCII x) = renderCode def doc in
         print x
 
 ------------------------------------------------------------------------

src/HERMIT/GHCI.hs

@@ -66,8 +66,11 @@ server passInfo opts skernel initAST = do
         resume :: Bool
         resume = "resume" `elem` opts
 
+        quietMode :: Bool
+        quietMode = "--quiet" `elem` opts
+
         otherOpts :: [CommandLineOption]
-        otherOpts = filter (not . (`elem` ("resume":maybeToList mbScript))) opts
+        otherOpts = filter (not . (`elem` ("--quiet":"resume":maybeToList mbScript))) opts
     unless (null otherOpts) $ do
         putStr "Ignored command-line arguments: "
         forM_ otherOpts $ \opt -> putStr opt >> putChar ' '
@@ -114,7 +117,7 @@ server passInfo opts skernel initAST = do
         post "/" jsonRpc
 
     _code <- withSystemTempFile ".ghci-hermit" $ \fp h -> do
-        hPutStrLn h $ hermitShellDotfile mbScript
+        hPutStrLn h $ hermitShellDotfile quietMode mbScript
         hClose h
 
         let ghci = (shell . unwords $ "ghci" : hermitShellFlags fp) {
@@ -150,9 +153,11 @@ msgBuilder :: String -> Status -> Wai.Response
 msgBuilder msg s = Wai.responseBuilder s [("Content-Type","application/json")]
     . lazyByteString . Aeson.encode $ Msg msg
 
-hermitShellDotfile :: Maybe FilePath -> String
-hermitShellDotfile mbScript = unlines $
+hermitShellDotfile :: Bool -> Maybe FilePath -> String
+hermitShellDotfile quietMode mbScript = unlines $
   [ ":m HERMIT.API" -- NOTE: All other modules intentionally unimported here
+  , ":m +HERMIT.API.Types"
+  , "import Data.IORef (writeIORef, modifyIORef)"
   , "import Prelude hiding (log, repeat)"
   , ":set prompt \"HERMIT> \""
 
@@ -163,14 +168,20 @@ hermitShellDotfile mbScript = unlines $
   , ":def! resume \\s -> return $ \"resume\\n:quit\""
   , ":def! abort \\s -> return $ \"abort\\n:quit\""
   , ":def! doc \\s -> return $ \":!hoogle --info \" ++ show s ++ \" +hermit-shell\""
+  , ":def! quiet \\s -> return $ \"modifyIORef quietModeM not\""
 --   , "send welcome" -- welcome message (interactive only)a
+  , "writeIORef quietModeM " ++ show quietMode
   , "send display" -- where am I (interactive only)
 --   , "setPath (rhsOf \"rev\")"
   ] ++ maybe []
              (\script ->
                 let moduleName' = takeWhile (/='.') script
-                in [":l " ++ script, moduleName' ++ ".script"])
+                in [":l " ++ script
+                   , moduleName' ++ ".script"
+                   ])
              mbScript
+         -- More obvious default interactive REPL behavior:
+    ++ [ "writeIORef quietModeM False" ]
 
 hermitShellFlags :: FilePath -> [String]
 hermitShellFlags dotfilePath =

src/HERMIT/GHCI/Client.hs

@@ -16,6 +16,8 @@ import HERMIT.Debug (debug)
 import HERMIT.GHCI.JSON
 import HERMIT.GHCI.Glyph
 
+import Data.IORef (readIORef)
+
 
 -- For better error messages
 import Data.Text (Text, unpack)
@@ -53,6 +55,10 @@ send (Shell g) = do
              error $ "failed to parse result value for " ++
                      genMethodStr True g ++ ": " ++ show v ++ " : " ++ msg
          ShellResult gss a -> do
+          quietMode <- readIORef quietModeM
+          if quietMode
+            then return a
+            else do
                  sequence_ [ withNoStyle sty txt
                            | gs <- gss
                            , Glyph txt sty <- gs

src/HERMIT/GHCI/Printer.hs

@@ -22,7 +22,7 @@ class Repl a where
 instance __OVERLAPPABLE__ Show a => Repl a where
   printForRepl = print
 
-instance __OVERLAPPING__ Response a => Repl (Shell a) where
+instance __OVERLAPPING__ (Response a) => Repl (Shell a) where
   printForRepl sh = do
         r <- send sh
         printResponse r
@@ -42,10 +42,10 @@ instance Repl QueryFun where
 instance Repl Crumb where
   printForRepl = printForRepl . run
 
-instance Guts a => Repl (Transform a LocalPath) where
+instance (Guts a) => Repl (Transform a LocalPath) where
   printForRepl = printForRepl . run
 
-instance Guts a => Repl (Transform a a) where
+instance (Guts a) => Repl (Transform a a) where
   printForRepl = printForRepl . run
 
 {-