@@ -6,16 +6,16 @@ module Obelisk.CliApp.Spinner (withSpinner) where
66
77import Control.Concurrent (killThread, threadDelay)
88import Control.Monad (forM_, (>=>))
9−import Control.Monad.Catch (MonadMask, mask, onException)
9+import Control.Monad.Catch (MonadMask, bracket_, mask, onException)
1010import Control.Monad.IO.Class
11−import Control.Monad.Log (logMessage)
11+import Control.Monad.Log (Severity (..), logMessage)
1212import Control.Monad.Reader (MonadIO)
1313import Data.IORef
1414import qualified Data.List as L
1515import Data.Text (Text)
1616import System.Console.ANSI (Color (Blue, Cyan, Green, Red))
1717
18−import Obelisk.CliApp.Logging (allowUserToMakeLoggingVerbose, fork)
18+import Obelisk.CliApp.Logging (allowUserToMakeLoggingVerbose, fork, putLog)
1919import Obelisk.CliApp.TerminalString (TerminalString (..), enquiryCode)
2020import Obelisk.CliApp.Types (Cli, CliConfig (..), HasCliConfig, Output (..), getCliConfig)
2121
@@ -23,22 +23,26 @@ import Obelisk.CliApp.Types (Cli, CliConfig (..), HasCliConfig, Output (..), get
2323withSpinner
2424 :: (MonadIO m, MonadMask m, Cli m, HasCliConfig m)
2525 => Text -> m a -> m a
26−withSpinner s = bracket' start cleanup . const
26+withSpinner s f = do
27+ noSpinner <- _cliConfig_noSpinner <$> getCliConfig
28+ if noSpinner
29+ then bracket_ runFake (pure ()) f
30+ else bracket' run cleanup $ const f
2731 where
28− start = do
29− tids <- run
30− tid <- fork $ allowUserToMakeLoggingVerbose enquiryCode
31− pure $ tid : tids
32+ runFake = do
33+ putLog Notice s
34+ pure []
3235 run = do
3336 -- Add this log to the spinner stack
3437 stack <- _cliConfig_spinnerStack <$> getCliConfig
3538 wasEmpty <- liftIO $ atomicModifyIORef' stack $ \old -> (TerminalString_Normal s : old, null old)
3639 if wasEmpty
3740 then do -- Fork a thread to manage output of anything on the stack
38− tid <- fork $ runSpinner spinner $ \c -> do
41+ ctrleThread <- fork $ allowUserToMakeLoggingVerbose enquiryCode
42+ spinnerThread <- fork $ runSpinner spinner $ \c -> do
3943 logs <- liftIO $ concatStack c <$> readIORef stack
4044 logMessage $ Output_Overwrite logs
41− pure [tid]
45+ pure [ctrleThread, spinnerThread]
4246 else pure []
4347 cleanup failed tids = do
4448 stack <- _cliConfig_spinnerStack <$> getCliConfig