git.iko.soy/obelisk
on master help sign in
Support nested spinners
commitc2dc2d49ccdd465e14f68b8cfdc00e23c3de997a authorTom Smalley <tfsmalley@gmail.com> dateFri 18 May 2018, 12:41 (8 years ago) parent86b650b
3 files changed+42−8
compare with master
unifiedsplit
lib/command/src/Obelisk/CLI.hs+12−1 lib/command/src/Obelisk/CLI/Logging.hs+3−1 lib/command/src/Obelisk/CLI/Spinner.hs+27−6
lib/command/src/Obelisk/CLI.hs+12−1
@@ -33,10 +33,21 @@ withSpinner s action = do
3333 False -> withSpinner' (_obelisk_logging conf) s action
3434
3535cliDemo :: MonadObelisk m => m ()
36−cliDemo = do
36+cliDemo = withSpinner "CLI Demo" $ do
3737 putLog Notice "This demo will showcase the CLI library functionality"
3838 withSpinner "Running some long-running task" $ do
3939 delay
40+ withSpinner "Nested task" $ do
41+ delay
42+ putLog Notice "In nested task"
43+ withSpinner "Inbetween" $ do
44+ withSpinner "Nested task" $ do
45+ delay
46+ putLog Notice "This task has the same name and still works"
47+ delay
48+ delay
49+ putLog Error "Top nested task finished"
50+ delay
4051 putLog Error "Some user error while spinning"
4152 delay
4253 putLog Notice "This is some info mesage"
lib/command/src/Obelisk/CLI/Logging.hs+3−1
@@ -42,6 +42,7 @@ data LoggingConfig = LoggingConfig
4242 , _loggingConfig_noColor :: Bool -- Disallow coloured output
4343 , _loggingConfig_lock :: MVar Bool -- Whether the last message was an Overwrite output
4444 , _loggingConfig_tipDisplayed :: IORef Bool -- Whether the user tip (to make verbose) was already displayed
45+ , _loggingConfig_stack :: IORef [Text] -- Stack of logs from nested spinners
4546 }
4647
4748newLoggingConfig :: Severity -> Bool -> IO LoggingConfig
@@ -49,7 +50,8 @@ newLoggingConfig sev noColor = do
4950 level <- newIORef sev
5051 lock <- newMVar False
5152 tipDisplayed <- newIORef False
52− return $ LoggingConfig level noColor lock tipDisplayed
53+ stack <- newIORef []
54+ return $ LoggingConfig level noColor lock tipDisplayed stack
5355
5456verboseLogLevel :: Severity
5557verboseLogLevel = Debug
lib/command/src/Obelisk/CLI/Spinner.hs+27−6
@@ -1,4 +1,5 @@
11{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE LambdaCase #-}
23{-# LANGUAGE MultiParamTypeClasses #-}
34{-# LANGUAGE OverloadedStrings #-}
45-- | Provides a simple CLI spinner that interoperates cleanly with the rest of the logging output.
@@ -7,27 +8,43 @@ module Obelisk.CLI.Spinner (withSpinner') where
78import Control.Concurrent (killThread, threadDelay)
89import Control.Monad (forM_, (>=>))
910import Control.Monad.Catch (MonadMask, mask, onException)
10−import Control.Monad.IO.Class (liftIO)
1111import Control.Monad.Log (MonadLog, logMessage)
1212import Control.Monad.Reader (MonadIO)
13+import Control.Monad.IO.Class
14+import Data.IORef
1315import Data.Text (Text)
1416import qualified Data.Text as T
1517import System.Console.ANSI (Color (Cyan, Green, Red), ColorIntensity (Vivid), ConsoleLayer (Foreground),
1618 SGR (Reset, SetColor), setSGRCode)
19+import Data.List (delete)
1720
18−import Obelisk.CLI.Logging (LoggingConfig, Output (..), allowUserToMakeLoggingVerbose, forkML)
21+import Obelisk.CLI.Logging (LoggingConfig(..), Output (..), allowUserToMakeLoggingVerbose, forkML)
1922
2023-- | Run an action with a CLI spinner.
2124withSpinner'
2225 :: (MonadIO m, MonadMask m, MonadLog Output m)
2326 => LoggingConfig -> Text -> m a -> m a
24−withSpinner' conf s = bracket' (sequence [run, forkML conf $ allowUserToMakeLoggingVerbose conf enquiryCode]) cleanup . const
27+withSpinner' conf s = bracket' start cleanup . const
2528 where
26− run = forkML conf $ do
27− runSpinner spinner $ \c -> do
28− logMessage $ Output_Overwrite [c, " ", T.unpack s]
29+ start = do
30+ tids <- run
31+ tid <- forkML conf $ allowUserToMakeLoggingVerbose conf enquiryCode
32+ pure $ tid : tids
33+ stack = _loggingConfig_stack conf
34+ run = do
35+ -- Add this log to the spinner stack
36+ wasEmpty <- liftIO $ atomicModifyIORef' stack $ \old -> (s : old, null old)
37+ if wasEmpty
38+ then do -- Fork a thread to manage output of anything on the stack
39+ tid <- forkML conf $ runSpinner spinner $ \c -> do
40+ logs <- liftIO $ concatStack <$> readIORef stack
41+ logMessage $ Output_Overwrite [c, " ", T.unpack logs]
42+ pure [tid]
43+ else pure []
2944 cleanup failed tids = do
3045 liftIO $ mapM_ killThread tids
46+ -- Delete this log from the spinner stack
47+ liftIO $ modifyIORef' stack $ delete s
3148 logMessage Output_ClearLine
3249 let mark = if failed
3350 then withColor Red "✖"
@@ -35,6 +52,10 @@ withSpinner' conf s = bracket' (sequence [run, forkML conf $ allowUserToMakeLogg
3552 logMessage $ Output_Overwrite [mark, " ", T.unpack s, "\n"]
3653 spinner = coloredSpinner defaultSpinnerTheme
3754
55+-- | How nested spinner logs should be displayed
56+concatStack :: [Text] -> Text
57+concatStack = T.intercalate " |> " . reverse
58+
3859-- | A spinner is simply an infinite list of strings that supplant each other in a delayed loop, creating the
3960-- animation of a "spinner".
4061type Spinner = [String]