@@ -21,6 +21,7 @@ import qualified Data.List as L
2121import Data.Maybe (isNothing)
2222import Data.Text (Text)
2323import System.Console.ANSI (Color (Blue, Cyan, Green, Red))
24+import System.IO (utf8, utf8_bom, utf16, utf16be, utf16le, utf32, utf32be, utf32le, TextEncoding)
2425
2526import Obelisk.CliApp.Logging (allowUserToMakeLoggingVerbose, fork, putLog)
2627import Obelisk.CliApp.TerminalString (TerminalString (..), enquiryCode)
@@ -51,34 +52,46 @@ 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
57+ mTextEncoding = _cliConfig_textEncoding cliConf
5558 if noSpinner
5659 then putLog Notice msg >> action
57− else bracket' run cleanup $ const action
60+ else bracket' (run mTextEncoding) (cleanup mTextEncoding) $ const action
5861 where
59− run = do
62+ run mTextEncoding = do
6063 -- Add this log to the spinner stack, and start a spinner if it is top-level.
6164 modifyStack pushSpinner >>= \case
6265 True -> do -- Top-level spinner; fork a thread to manage output of anything on the stack
6366 ctrleThread <- fork $ allowUserToMakeLoggingVerbose enquiryCode
64− spinnerThread <- fork $ runSpinner spinner $ \c -> do
65− logs <- renderSpinnerStack c . snd <$> readStack
67+ spinnerThread <- fork $ runSpinner (spinner mTextEncoding) $ \c -> do
68+ logs <- renderSpinnerStack mTextEncoding c . snd <$> readStack
6669 logMessage $ Output_Overwrite logs
6770 pure [ctrleThread, spinnerThread]
6871 False -> -- Sub-spinner; nothing to do.
6972 pure []
70− cleanup tids resultM = do
73+ cleanup mTextEncoding tids resultM = do
7174 liftIO $ mapM_ killThread tids
7275 logMessage Output_ClearLine
73− logsM <- modifyStack $ popSpinner $ case resultM of
74− Nothing ->
75− ( TerminalString_Colorized Red "FAILED"
76− , Just msg -- Always display final message if there was an exception.
77− )
78− Just result ->
79− ( TerminalString_Colorized Green "DONE"
80− , mkTrail <*> pure result
81− )
76+ logsM <- modifyStack $ (popSpinner mTextEncoding) $ case resultM of
77+ Nothing -> case mTextEncoding of
78+ Just enc | supportUnicode enc ->
79+ ( TerminalString_Colorized Red "✖"
80+ , Just msg -- Always display final message if there was an exception.
81+ )
82+ _ ->
83+ ( TerminalString_Colorized Red "FAILED"
84+ , Just msg -- Always display final message if there was an exception.
85+ )
86+ Just result -> case mTextEncoding of
87+ Just enc | supportUnicode enc ->
88+ ( TerminalString_Colorized Green "✔"
89+ , mkTrail <*> pure result
90+ )
91+ _ ->
92+ ( TerminalString_Colorized Green "DONE"
93+ , mkTrail <*> pure result
94+ )
8295 -- Last message, finish off with newline.
8396 forM_ logsM $ logMessage . Output_Write
8497 pushSpinner (flag, old) =
@@ -87,10 +100,10 @@ withSpinner' msg mkTrail action = do
87100 )
88101 where
89102 isTemporary = isNothing mkTrail
90− popSpinner (mark, trailMsgM) (flag, old) =
103+ popSpinner mTextEncoding (mark, trailMsgM) (flag, old) =
91104 ( (newFlag, new)
92105 -- With final trail spinner message to render
93− , renderSpinnerStack mark . (: new) . TerminalString_Normal <$> (
106+ , renderSpinnerStack mTextEncoding mark . (: new) . TerminalString_Normal <$> (
94107 if inTemporarySpinner then Nothing else trailMsgM
95108 )
96109 )
@@ -102,19 +115,36 @@ withSpinner' msg mkTrail action = do
102115 =<< fmap _cliConfig_spinnerStack getCliConfig
103116 modifyStack f = liftIO . flip atomicModifyIORef' f
104117 =<< fmap _cliConfig_spinnerStack getCliConfig
105− spinner = coloredSpinner minimalSpinnerTheme
118+ spinner mTextEncoding = case mTextEncoding of
119+ Just enc | supportUnicode enc -> coloredSpinner defaultSpinnerTheme
120+ _ -> coloredSpinner minimalSpinnerTheme
121+
122+supportUnicode :: TextEncoding -> Bool
123+supportUnicode enc = any ((show enc ==) . show)
124+ [ utf8
125+ , utf8_bom
126+ , utf16
127+ , utf16be
128+ , utf16le
129+ , utf32
130+ , utf32be
131+ , utf32le
132+ ]
106133
107134-- | How nested spinner logs should be displayed
108135renderSpinnerStack
109− :: TerminalString -- ^ That which comes before the final element in stack
136+ :: Maybe TextEncoding
137+ -> TerminalString -- ^ That which comes before the final element in stack
110138 -> [TerminalString] -- ^ Spinner elements in reverse order
111139 -> [TerminalString]
112−renderSpinnerStack mark = L.intersperse space . go . L.reverse
140+renderSpinnerStack mTextEncoding mark = L.intersperse space . go . L.reverse
113141 where
114142 go [] = []
115143 go (x:[]) = mark : [x]
116144 go (x:xs) = arrow : x : go xs
117− arrow = TerminalString_Colorized Blue "->"
145+ arrow = case mTextEncoding of
146+ Just enc | supportUnicode enc -> TerminalString_Colorized Blue "⇾"
147+ _ -> TerminalString_Colorized Blue "->"
118148 space = TerminalString_Normal " "
119149
120150-- | A spinner is simply an infinite list of strings that supplant each other in a delayed loop, creating the
@@ -139,9 +169,18 @@ _spinnerSticks = ["|", "/", "-", "\\"]
139169spinnerStick :: SpinnerTheme
140170spinnerStick = ["|", "/", "-", "\\"]
141171
172+_spinnerCircleHalves :: SpinnerTheme
173+_spinnerCircleHalves = ["◐", "◓", "◑", "◒"]
174+
175+spinnerMoon :: SpinnerTheme
176+spinnerMoon = ["🌑", "🌒", "🌓", "🌔", "🌕", "🌖", "🌗", "🌘"]
177+
142178minimalSpinnerTheme :: SpinnerTheme
143179minimalSpinnerTheme = spinnerStick
144180
181+defaultSpinnerTheme :: SpinnerTheme
182+defaultSpinnerTheme = spinnerMoon
183+
145184-- | Like `bracket` but the `release` function can know whether an exception was raised
146185bracket' :: MonadMask m => m a -> (a -> Maybe c -> m b) -> (a -> m c) -> m c
147186bracket' acquire release use = mask $ \unmasked -> do