@@ -1,6 +1,6 @@
11{-# LANGUAGE FlexibleContexts #-}
22{-# LANGUAGE MultiParamTypeClasses #-}
3−module Obelisk.CLI.Spinner where
3+module Obelisk.CLI.Spinner (withSpinner') where
44
55import Control.Concurrent (forkIO, killThread, threadDelay)
66import Control.Monad (forM_)
@@ -10,6 +10,8 @@ import Control.Monad.Log (MonadLog, logMessage, runLoggingT)
1010import Control.Monad.Reader (MonadIO)
1111import Data.Text (Text)
1212import qualified Data.Text as T
13+import System.Console.ANSI (Color (Magenta), ColorIntensity (Vivid), ConsoleLayer (Foreground),
14+ SGR (Reset, SetColor), setSGRCode)
1315
1416import Obelisk.CLI.Logging (LoggingConfig, Output (..), handleLog)
1517
@@ -22,13 +24,41 @@ withSpinner' c s = bracket run cleanup . const
2224 where
2325 -- TODO: Can we obviate passing LoggingConfig just to use forkIO?
2426 run = liftIO $ forkIO $ flip runLoggingT (handleLog c) $ do
25− forM_ (cycle spinner1) $ \e -> do
26− logMessage $ Output_Raw ["\r", [e], " ", T.unpack s]
27+ forM_ (coloredSpinner spinnerPoint) $ \e -> do
28+ logMessage $ Output_Raw ["\r", e, " ", T.unpack s]
2729 delay
2830 cleanup tid = do
2931 liftIO $ killThread tid
3032 logMessage Output_ClearLine
3133 delay = liftIO $ threadDelay 100000 -- A shorter delay ensures that we update promptly.
3234
33−spinner1 :: String
34−spinner1 = "◐◓◑◒"
35+type Spinner = [String]
36+
37+spinner :: SpinnerTheme -> Spinner
38+spinner = cycle
39+
40+coloredSpinner :: SpinnerTheme -> Spinner
41+coloredSpinner = spinner . fmap withColor
42+ where
43+ withColor s = mconcat
44+ [ setSGRCode [SetColor Foreground Vivid color]
45+ , s
46+ , setSGRCode [Reset]
47+ ]
48+ color = Magenta
49+
50+-- Some spinners from https://github.com/sindresorhus/cli-spinners/blob/master/spinners.json
51+
52+type SpinnerTheme = [String]
53+
54+spinnerPoint :: SpinnerTheme
55+spinnerPoint =
56+ [ "∙∙∙"
57+ , "●∙∙"
58+ , "∙●∙"
59+ , "∙∙●"
60+ , "∙∙∙"
61+ ]
62+
63+-- spinnerCircleHalves :: SpinnerTheme
64+-- spinnerCircleHalves = ["◐", "◓", "◑", "◒"]