git.iko.soy/obelisk
on master help sign in
Merge pull request #98 from tomsmalley/tom-more-logging

Support nested logging spinners

commit4e132223dfcb03ed21c5a0b71a6341cd85bb452b authorLuigy Leon <luichi.19@gmail.com> dateSat 19 May 2018, 20:09 (8 years ago) parent8b69a0b1ff747a
4 files changed+63−29
compare with master
unifiedsplit
lib/command/src/Obelisk/CLI.hs+12−1 lib/command/src/Obelisk/CLI/Logging.hs+8−8 lib/command/src/Obelisk/CLI/Spinner.hs+30−8 lib/command/src/Obelisk/Command/Project.hs+13−12
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+8−8
@@ -35,13 +35,14 @@ import System.Exit (ExitCode (ExitFailure), exitWith)
3535import System.IO (BufferMode (NoBuffering), hFlush, hReady, hSetBuffering, stdin, stdout)
3636
3737import Control.Monad.Log (LoggingT, MonadLog, Severity (..), WithSeverity (..), logMessage, runLoggingT)
38−import Data.IORef (IORef, newIORef, readIORef, writeIORef)
38+import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef')
3939
4040data LoggingConfig = LoggingConfig
4141 { _loggingConfig_level :: IORef Severity -- We are capable of changing the log level at runtime
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
@@ -155,12 +157,10 @@ allowUserToMakeLoggingVerbose conf keyCode = bracket showTip (liftIO . killThrea
155157 setLogLevel conf verboseLogLevel
156158 where
157159 showTip = forkML conf $ unlessVerbose $ do
158− tipDisplayed <- liftIO $ readIORef $ _loggingConfig_tipDisplayed conf
159− unless tipDisplayed $ do
160− liftIO $ threadDelay $ 3*1000000 -- Only show tip for actions taking too long (3 seconds or more)
161− unlessVerbose $ do -- Check again in case the user had pressed Ctrl+e recently
162− putLog Notice $ "Tip: Press Ctrl+e to display full output"
163− liftIO $ writeIORef (_loggingConfig_tipDisplayed conf) True
160+ liftIO $ threadDelay $ 3*1000000 -- Only show tip for actions taking too long (3 seconds or more)
161+ tipDisplayed <- liftIO $ atomicModifyIORef' (_loggingConfig_tipDisplayed conf) $ (,) True
162+ unless tipDisplayed $ unlessVerbose $ do -- Check again in case the user had pressed Ctrl+e recently
163+ putLog Notice $ "Tip: Press Ctrl+e to display full output"
164164 unlessVerbose f = do
165165 l <- getLogLevel conf
166166 unless (l == verboseLogLevel) f
lib/command/src/Obelisk/CLI/Spinner.hs+30−8
@@ -7,34 +7,56 @@ module Obelisk.CLI.Spinner (withSpinner') where
77import Control.Concurrent (killThread, threadDelay)
88import Control.Monad (forM_, (>=>))
99import Control.Monad.Catch (MonadMask, mask, onException)
10−import Control.Monad.IO.Class (liftIO)
10+import Control.Monad.IO.Class
1111import Control.Monad.Log (MonadLog, logMessage)
1212import Control.Monad.Reader (MonadIO)
13+import Data.IORef
14+import Data.List (delete)
1315import Data.Text (Text)
1416import qualified Data.Text as T
15−import System.Console.ANSI (Color (Cyan, Green, Red), ColorIntensity (Vivid), ConsoleLayer (Foreground),
17+import System.Console.ANSI (Color (Blue, Cyan, Green, Red), ColorIntensity (Vivid), ConsoleLayer (Foreground),
1618 SGR (Reset, SetColor), setSGRCode)
1719
18−import Obelisk.CLI.Logging (LoggingConfig, Output (..), allowUserToMakeLoggingVerbose, forkML)
20+import Obelisk.CLI.Logging (LoggingConfig (..), Output (..), allowUserToMakeLoggingVerbose, forkML)
1921
2022-- | Run an action with a CLI spinner.
2123withSpinner'
2224 :: (MonadIO m, MonadMask m, MonadLog Output m)
2325 => LoggingConfig -> Text -> m a -> m a
24−withSpinner' conf s = bracket' (sequence [run, forkML conf $ allowUserToMakeLoggingVerbose conf enquiryCode]) cleanup . const
26+withSpinner' conf s = bracket' start cleanup . const
2527 where
26− run = forkML conf $ do
27− runSpinner spinner $ \c -> do
28− logMessage $ Output_Overwrite [c, " ", T.unpack s]
28+ start = do
29+ tids <- run
30+ tid <- forkML conf $ allowUserToMakeLoggingVerbose conf enquiryCode
31+ pure $ tid : tids
32+ stack = _loggingConfig_stack conf
33+ run = do
34+ -- Add this log to the spinner stack
35+ wasEmpty <- liftIO $ atomicModifyIORef' stack $ \old -> (s : old, null old)
36+ if wasEmpty
37+ then do -- Fork a thread to manage output of anything on the stack
38+ tid <- forkML conf $ runSpinner spinner $ \c -> do
39+ logs <- liftIO $ concatStack c <$> readIORef stack
40+ logMessage $ Output_Overwrite [logs]
41+ pure [tid]
42+ else pure []
2943 cleanup failed tids = do
3044 liftIO $ mapM_ killThread tids
3145 logMessage Output_ClearLine
3246 let mark = if failed
3347 then withColor Red "✖"
3448 else withColor Green "✔"
35− logMessage $ Output_Overwrite [mark, " ", T.unpack s, "\n"]
49+ -- Delete this log from the spinner stack
50+ logs <- liftIO $ atomicModifyIORef' stack $ \old -> (delete s old, concatStack mark old)
51+ logMessage $ Output_Overwrite [logs, "\n"]
3652 spinner = coloredSpinner defaultSpinnerTheme
3753
54+-- | How nested spinner logs should be displayed
55+concatStack :: String -> [Text] -> String
56+concatStack mark = drop 1 . foldr flatten "" . zip (mark : repeat arrow) . fmap T.unpack
57+ where flatten (m, s) acc = unwords [acc, m, s]
58+ arrow = withColor Blue "⇾"
59+
3860-- | A spinner is simply an infinite list of strings that supplant each other in a delayed loop, creating the
3961-- animation of a "spinner".
4062type Spinner = [String]
lib/command/src/Obelisk/Command/Project.hs+13−12
@@ -66,18 +66,19 @@ toImplDir p = toObeliskDir p </> "impl"
6666initProject :: MonadObelisk m => InitSource -> m ()
6767initProject source = do
6868 let implDir = toImplDir "."
69− liftIO $ createDirectory $ toObeliskDir "."
70− case source of
71− InitSource_Default -> liftIO $ createThunkWithLatest implDir obeliskSource
72− InitSource_Branch branch -> liftIO $ createThunkWithLatest implDir $ obeliskSourceWithBranch branch
73− InitSource_Symlink path -> do
74− let symlinkPath = if isAbsolute path
75− then path
76− else ".." </> path
77− liftIO $ createSymbolicLink symlinkPath implDir
78− _ <- nixBuildAttrWithCache implDir "command"
79− --TODO: We should probably handoff to the impl here
80− skeleton <- nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this
69+ skeleton <- withSpinner "Setting up obelisk" $ do
70+ liftIO $ createDirectory $ toObeliskDir "."
71+ case source of
72+ InitSource_Default -> liftIO $ createThunkWithLatest implDir obeliskSource
73+ InitSource_Branch branch -> liftIO $ createThunkWithLatest implDir $ obeliskSourceWithBranch branch
74+ InitSource_Symlink path -> do
75+ let symlinkPath = if isAbsolute path
76+ then path
77+ else ".." </> path
78+ liftIO $ createSymbolicLink symlinkPath implDir
79+ _ <- nixBuildAttrWithCache implDir "command"
80+ --TODO: We should probably handoff to the impl here
81+ nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this
8182 withSpinner "Copying project skeleton" $ do
8283 callProcessAndLogOutput (Notice, Error) $
8384 cp --TODO: Make this package depend on nix-prefetch-url properly