@@ -24,6 +24,7 @@ import System.Console.ANSI (Color (Blue, Cyan, Green, Red))
2424
2525import Obelisk.CliApp.Logging (allowUserToMakeLoggingVerbose, fork, putLog)
2626import Obelisk.CliApp.TerminalString (TerminalString (..), enquiryCode)
27+import Obelisk.CliApp.Theme
2728import Obelisk.CliApp.Types (CliLog, CliConfig (..), HasCliConfig, Output (..), getCliConfig)
2829
2930-- | Run an action with a CLI spinner.
@@ -51,7 +52,8 @@ withSpinner'
5152 -> m a
5253 -> m a
5354withSpinner' msg mkTrail action = do
54− noSpinner <- _cliConfig_noSpinner <$> getCliConfig
55+ cliConf <- getCliConfig
56+ let noSpinner = _cliConfig_noSpinner cliConf
5557 if noSpinner
5658 then putLog Notice msg >> action
5759 else bracket' run cleanup $ const action
@@ -61,8 +63,11 @@ withSpinner' msg mkTrail action = do
6163 modifyStack pushSpinner >>= \case
6264 True -> do -- Top-level spinner; fork a thread to manage output of anything on the stack
6365 ctrleThread <- fork $ allowUserToMakeLoggingVerbose enquiryCode
66+ cliConf <- getCliConfig
67+ let theme = _cliConfig_theme cliConf
68+ spinner = coloredSpinner $ _cliTheme_spinner theme
6469 spinnerThread <- fork $ runSpinner spinner $ \c -> do
65− logs <- renderSpinnerStack c . snd <$> readStack
70+ logs <- renderSpinnerStack theme c . snd <$> readStack
6671 logMessage $ Output_Overwrite logs
6772 pure [ctrleThread, spinnerThread]
6873 False -> -- Sub-spinner; nothing to do.
@@ -70,13 +75,15 @@ withSpinner' msg mkTrail action = do
7075 cleanup tids resultM = do
7176 liftIO $ mapM_ killThread tids
7277 logMessage Output_ClearLine
73− logsM <- modifyStack $ popSpinner $ case resultM of
78+ cliConf <- getCliConfig
79+ let theme = _cliConfig_theme cliConf
80+ logsM <- modifyStack $ (popSpinner theme) $ case resultM of
7481 Nothing ->
75− ( TerminalString_Colorized Red "✖"
82+ ( TerminalString_Colorized Red $ _cliTheme_failed $ _cliConfig_theme cliConf
7683 , Just msg -- Always display final message if there was an exception.
7784 )
7885 Just result ->
79− ( TerminalString_Colorized Green "✔"
86+ ( TerminalString_Colorized Green $ _cliTheme_done $ _cliConfig_theme cliConf
8087 , mkTrail <*> pure result
8188 )
8289 -- Last message, finish off with newline.
@@ -87,10 +94,10 @@ withSpinner' msg mkTrail action = do
8794 )
8895 where
8996 isTemporary = isNothing mkTrail
90− popSpinner (mark, trailMsgM) (flag, old) =
97+ popSpinner theme (mark, trailMsgM) (flag, old) =
9198 ( (newFlag, new)
9299 -- With final trail spinner message to render
93− , renderSpinnerStack mark . (: new) . TerminalString_Normal <$> (
100+ , renderSpinnerStack theme mark . (: new) . TerminalString_Normal <$> (
94101 if inTemporarySpinner then Nothing else trailMsgM
95102 )
96103 )
@@ -102,19 +109,19 @@ withSpinner' msg mkTrail action = do
102109 =<< fmap _cliConfig_spinnerStack getCliConfig
103110 modifyStack f = liftIO . flip atomicModifyIORef' f
104111 =<< fmap _cliConfig_spinnerStack getCliConfig
105− spinner = coloredSpinner defaultSpinnerTheme
106112
107113-- | How nested spinner logs should be displayed
108114renderSpinnerStack
109− :: TerminalString -- ^ That which comes before the final element in stack
115+ :: CliTheme
116+ -> TerminalString -- ^ That which comes before the final element in stack
110117 -> [TerminalString] -- ^ Spinner elements in reverse order
111118 -> [TerminalString]
112−renderSpinnerStack mark = L.intersperse space . go . L.reverse
119+renderSpinnerStack theme mark = L.intersperse space . go . L.reverse
113120 where
114121 go [] = []
115122 go (x:[]) = mark : [x]
116123 go (x:xs) = arrow : x : go xs
117− arrow = TerminalString_Colorized Blue "⇾"
124+ arrow = TerminalString_Colorized Blue $ _cliTheme_arrow theme
118125 space = TerminalString_Normal " "
119126
120127-- | A spinner is simply an infinite list of strings that supplant each other in a delayed loop, creating the
@@ -130,12 +137,6 @@ runSpinner spinner f = forM_ spinner $ f >=> const delay
130137 where
131138 delay = liftIO $ threadDelay 100000 -- A shorter delay ensures that we update promptly.
132139
133−type SpinnerTheme = [Text]
134−
135−-- Find more spinners at https://github.com/sindresorhus/cli-spinners/blob/master/spinners.json
136−defaultSpinnerTheme :: SpinnerTheme
137−defaultSpinnerTheme = ["◐", "◓", "◑", "◒"]
138−
139140-- | Like `bracket` but the `release` function can know whether an exception was raised
140141bracket' :: MonadMask m => m a -> (a -> Maybe c -> m b) -> (a -> m c) -> m c
141142bracket' acquire release use = mask $ \unmasked -> do