git.iko.soy/spin
on master help sign in
spin/src/Spin/Functions.hs
81 lines 1.8 kB history raw
1{-# LANGUAGE RecordWildCards #-}
3module Spin.Functions
4 ( withSpinner
5 ) where
7import Control.Applicative
8import Control.Concurrent
9import Control.Exception
10import Data.IORef
11import Data.Maybe
12import System.Console.ANSI
14import Spin.Types
15import System.IO
17defaultConfig :: Config
18defaultConfig = Config
19 { configMessage = ""
20 , configPrefix = ""
21 , configSymbol = ""
22 , configSticky = False
23 }
25withSpinner
26 :: Spec
27 -> (((Config -> Config) -> IO ()) -> IO a)
28 -> IO a
29withSpinner spec fn = do
30 hideCursor
31 configIORef <- newIORef defaultConfig
32 threadId <- forkIO $ tick spec configIORef 0
33 finally (fn (modifyIORef configIORef)) (cleanup threadId configIORef)
35cleanup :: ThreadId -> IORef Config -> IO ()
36cleanup threadId configIORef = do
37 throwTo threadId ThreadKilled
38 resetLine
39 finalLine <- renderFinal <$> readIORef configIORef
40 case finalLine of
41 Just line -> putStrLn line
42 Nothing -> return ()
43 showCursor
45resetLine :: IO ()
46resetLine = do
47 clearLine
48 setCursorColumn 0
50usInMs :: Int
51usInMs = 1000
53tick :: Spec -> IORef Config -> Int -> IO ()
54tick spec@Spec{..} configIORef i = do
55 config <- readIORef configIORef
56 putStr $ renderTick spec i config
57 hFlush stdout
58 threadDelay $ usInMs * specInterval
59 resetLine
60 tick spec configIORef $ i + 1
62renderTick :: Spec -> Int -> Config -> String
63renderTick Spec{..} i Config{..} = unwords $ catMaybes
64 [ emptyMaybe configPrefix
65 , emptyMaybe configSymbol <|> (emptyMaybe $ cycle specFrames !! i)
66 , emptyMaybe configMessage
67 ]
69renderFinal :: Config -> Maybe String
70renderFinal Config{..} =
71 case configSticky of
72 True -> Just $ unwords $ mapMaybe emptyMaybe
73 [ configPrefix
74 , configSymbol
75 , configMessage
76 ]
77 False -> Nothing
79emptyMaybe :: [a] -> Maybe [a]
80emptyMaybe [] = Nothing
81emptyMaybe x = Just x