git.iko.soy/obelisk
on master help sign in
Merge pull request #56 from obsidiansystems/sr-disable-spinner
ca19585Ryan Trinkle
lib/cliapp/src/Obelisk/CliApp/Spinner.hs+10−9
compare with master
unifiedsplit
@@ -8,14 +8,14 @@ import Control.Concurrent (killThread, threadDelay)
8import Control.Monad (forM_, (>=>))
8import Control.Monad (forM_, (>=>))
9import Control.Monad.Catch (MonadMask, mask, onException)
9import Control.Monad.Catch (MonadMask, mask, onException)
10import Control.Monad.IO.Class
10import Control.Monad.IO.Class
11−import Control.Monad.Log (logMessage)
11+import Control.Monad.Log (Severity (..), logMessage)
12import Control.Monad.Reader (MonadIO)
12import Control.Monad.Reader (MonadIO)
13import Data.IORef
13import Data.IORef
14import qualified Data.List as L
14import qualified Data.List as L
15import Data.Text (Text)
15import Data.Text (Text)
16import System.Console.ANSI (Color (Blue, Cyan, Green, Red))
16import System.Console.ANSI (Color (Blue, Cyan, Green, Red))
17
17
18−import Obelisk.CliApp.Logging (allowUserToMakeLoggingVerbose, fork)
18+import Obelisk.CliApp.Logging (allowUserToMakeLoggingVerbose, fork, putLog)
19import Obelisk.CliApp.TerminalString (TerminalString (..), enquiryCode)
19import Obelisk.CliApp.TerminalString (TerminalString (..), enquiryCode)
20import Obelisk.CliApp.Types (Cli, CliConfig (..), HasCliConfig, Output (..), getCliConfig)
20import Obelisk.CliApp.Types (Cli, CliConfig (..), HasCliConfig, Output (..), getCliConfig)
21
21
@@ -23,22 +23,23 @@ import Obelisk.CliApp.Types (Cli, CliConfig (..), HasCliConfig, Output (..), get
23withSpinner
23withSpinner
24 :: (MonadIO m, MonadMask m, Cli m, HasCliConfig m)
24 :: (MonadIO m, MonadMask m, Cli m, HasCliConfig m)
25 => Text -> m a -> m a
25 => Text -> m a -> m a
26+withSpinner s f = do
27+ noSpinner <- _cliConfig_noSpinner <$> getCliConfig
28+ if noSpinner
29+ then putLog Notice s >> f
26−withSpinner s = bracket' start cleanup . const
30+ else bracket' run cleanup $ const f
27 where
31 where
28− start = do
29− tids <- run
30− tid <- fork $ allowUserToMakeLoggingVerbose enquiryCode
31− pure $ tid : tids
32 run = do
32 run = do
33 -- Add this log to the spinner stack
33 -- Add this log to the spinner stack
34 stack <- _cliConfig_spinnerStack <$> getCliConfig
34 stack <- _cliConfig_spinnerStack <$> getCliConfig
35 wasEmpty <- liftIO $ atomicModifyIORef' stack $ \old -> (TerminalString_Normal s : old, null old)
35 wasEmpty <- liftIO $ atomicModifyIORef' stack $ \old -> (TerminalString_Normal s : old, null old)
36 if wasEmpty
36 if wasEmpty
37 then do -- Fork a thread to manage output of anything on the stack
37 then do -- Fork a thread to manage output of anything on the stack
38+ ctrleThread <- fork $ allowUserToMakeLoggingVerbose enquiryCode
38− tid <- fork $ runSpinner spinner $ \c -> do
39+ spinnerThread <- fork $ runSpinner spinner $ \c -> do
39 logs <- liftIO $ concatStack c <$> readIORef stack
40 logs <- liftIO $ concatStack c <$> readIORef stack
40 logMessage $ Output_Overwrite logs
41 logMessage $ Output_Overwrite logs
41− pure [tid]
42+ pure [ctrleThread, spinnerThread]
42 else pure []
43 else pure []
43 cleanup failed tids = do
44 cleanup failed tids = do
44 stack <- _cliConfig_spinnerStack <$> getCliConfig
45 stack <- _cliConfig_spinnerStack <$> getCliConfig