Skip to content
Snippets Groups Projects
Commit 1fb0ba68 authored by Jens Nolte's avatar Jens Nolte
Browse files

Remove intermediate refactoring types

parent 7de6ecaf
No related branches found
No related tags found
No related merge requests found
...@@ -48,14 +48,11 @@ data CachedMode = CachedMode ...@@ -48,14 +48,11 @@ data CachedMode = CachedMode
-- |Block that 'yield's an update whenever the block should be changed -- |Block that 'yield's an update whenever the block should be changed
type PushBlock = PushBlockProducer type PushBlock = Producer BlockOutput IO PushMode
type PushBlockProducer = Producer BlockOutput IO PushMode
-- |Block that generates an update on 'yield'. Should only be pulled when an update is required. -- |Block that generates an update on 'yield'. Should only be pulled when an update is required.
type PullBlock = PullBlockProducer type PullBlock = Producer BlockOutput IO PullMode
type PullBlockProducer = Producer BlockOutput IO PullMode
-- |Cached block. Always 'yield's the latest update, so it should only be pulled when the bar is rendered. -- |Cached block. Always 'yield's the latest update, so it should only be pulled when the bar is rendered.
type CachedBlock = CachedBlockProducer type CachedBlock = Producer BlockOutput IO CachedMode
type CachedBlockProducer = Producer BlockOutput IO CachedMode
class IsBlock a where class IsBlock a where
toCachedBlock :: BarUpdateChannel -> a -> CachedBlock toCachedBlock :: BarUpdateChannel -> a -> CachedBlock
...@@ -185,7 +182,7 @@ cacheFromInput input = fmap (\_ -> CachedMode) $ fromInput input ...@@ -185,7 +182,7 @@ cacheFromInput input = fmap (\_ -> CachedMode) $ fromInput input
-- Returns an IO action that can be used to attach blocks to the shared interval and an async that contains a reference to the scheduler thread. -- Returns an IO action that can be used to attach blocks to the shared interval and an async that contains a reference to the scheduler thread.
sharedInterval :: BarUpdateChannel -> Int -> IO (PullBlock -> CachedBlock, Async ()) sharedInterval :: BarUpdateChannel -> Int -> IO (PullBlock -> CachedBlock, Async ())
sharedInterval barUpdateChannel seconds = do sharedInterval barUpdateChannel seconds = do
clientsMVar <- newMVar ([] :: [(MVar PullBlockProducer, Output BlockOutput)]) clientsMVar <- newMVar ([] :: [(MVar PullBlock, Output BlockOutput)])
task <- async $ forever $ do task <- async $ forever $ do
threadDelay $ seconds * 1000000 threadDelay $ seconds * 1000000
...@@ -197,11 +194,11 @@ sharedInterval barUpdateChannel seconds = do ...@@ -197,11 +194,11 @@ sharedInterval barUpdateChannel seconds = do
return (addClient clientsMVar, task) return (addClient clientsMVar, task)
where where
runAndFilterClient :: (MVar PullBlockProducer, Output BlockOutput) -> IO (Maybe (MVar PullBlockProducer, Output BlockOutput)) runAndFilterClient :: (MVar PullBlock, Output BlockOutput) -> IO (Maybe (MVar PullBlock, Output BlockOutput))
runAndFilterClient client = do runAndFilterClient client = do
result <- runClient client result <- runClient client
return $ if result then Just client else Nothing return $ if result then Just client else Nothing
runClient :: (MVar PullBlockProducer, Output BlockOutput) -> IO Bool runClient :: (MVar PullBlock, Output BlockOutput) -> IO Bool
runClient (blockProducerMVar, output) = runClient (blockProducerMVar, output) =
modifyMVar blockProducerMVar $ \blockProducer -> do modifyMVar blockProducerMVar $ \blockProducer -> do
result <- next blockProducer result <- next blockProducer
...@@ -228,7 +225,7 @@ sharedInterval barUpdateChannel seconds = do ...@@ -228,7 +225,7 @@ sharedInterval barUpdateChannel seconds = do
void $ runClient (blockProducerMVar, output) void $ runClient (blockProducerMVar, output)
-- Notify bar about changed block state, this is usually done by the shared interval handler -- Notify bar about changed block state, this is usually done by the shared interval handler
updateBar barUpdateChannel updateBar barUpdateChannel
addClient :: MVar [(MVar PullBlockProducer, Output BlockOutput)] -> PullBlockProducer -> CachedBlock addClient :: MVar [(MVar PullBlock, Output BlockOutput)] -> PullBlock -> CachedBlock
addClient clientsMVar blockProducer = do addClient clientsMVar blockProducer = do
-- Spawn the mailbox that preserves the latest block -- Spawn the mailbox that preserves the latest block
(output, input) <- lift $ spawn $ latest emptyBlock (output, input) <- lift $ spawn $ latest emptyBlock
......
...@@ -37,27 +37,27 @@ renderIndicator :: CachedBlock ...@@ -37,27 +37,27 @@ renderIndicator :: CachedBlock
-- Using 'cachedBlock' is a hack to actually get the block to update on every bar update (by doing this it will not get a cache later in the pipeline). -- Using 'cachedBlock' is a hack to actually get the block to update on every bar update (by doing this it will not get a cache later in the pipeline).
renderIndicator = forever $ each $ map createBlock ["/", "-", "\\", "|"] renderIndicator = forever $ each $ map createBlock ["/", "-", "\\", "|"]
runBlock :: CachedBlockProducer -> IO (Maybe (BlockOutput, CachedBlockProducer)) runBlock :: CachedBlock -> IO (Maybe (BlockOutput, CachedBlock))
runBlock producer = do runBlock producer = do
next' <- next producer next' <- next producer
return $ case next' of return $ case next' of
Left _ -> Nothing Left _ -> Nothing
Right (block, newProducer) -> Just (block, newProducer) Right (block, newProducer) -> Just (block, newProducer)
runBlocks :: [CachedBlockProducer] -> IO ([BlockOutput], [CachedBlockProducer]) runBlocks :: [CachedBlock] -> IO ([BlockOutput], [CachedBlock])
runBlocks blockProducers = unzip . catMaybes <$> mapM runBlock blockProducers runBlocks block = unzip . catMaybes <$> mapM runBlock block
renderLoop :: MainOptions -> Handle -> BarUpdateEvent -> BS.ByteString -> TChan CachedBlock -> IO () renderLoop :: MainOptions -> Handle -> BarUpdateEvent -> BS.ByteString -> TChan CachedBlock -> IO ()
renderLoop options handle@Handle{handleActiveFilter} barUpdateEvent previousBarOutput newBlockChan = renderLoop' previousBarOutput [] renderLoop options handle@Handle{handleActiveFilter} barUpdateEvent previousBarOutput newBlockChan = renderLoop' previousBarOutput []
where where
addNewBlockProducers :: [CachedBlock] -> IO [CachedBlock] addNewBlocks :: [CachedBlock] -> IO [CachedBlock]
addNewBlockProducers blockProducers = do addNewBlocks blocks = do
maybeNewBlock <- atomically $ tryReadTChan newBlockChan maybeNewBlock <- atomically $ tryReadTChan newBlockChan
case maybeNewBlock of case maybeNewBlock of
Nothing -> return blockProducers Nothing -> return blocks
Just newBlock -> addNewBlockProducers (newBlock:blockProducers) Just newBlock -> addNewBlocks (newBlock:blocks)
renderLoop' :: BS.ByteString -> [CachedBlock] -> IO () renderLoop' :: BS.ByteString -> [CachedBlock] -> IO ()
renderLoop' previousBarOutput' blockProducers = do renderLoop' previousBarOutput' blocks = do
blockFilter <- readIORef handleActiveFilter blockFilter <- readIORef handleActiveFilter
-- Wait for an event (unless the filter is animated) -- Wait for an event (unless the filter is animated)
...@@ -67,16 +67,16 @@ renderLoop options handle@Handle{handleActiveFilter} barUpdateEvent previousBarO ...@@ -67,16 +67,16 @@ renderLoop options handle@Handle{handleActiveFilter} barUpdateEvent previousBarO
threadDelay 10000 threadDelay 10000
Event.clear barUpdateEvent Event.clear barUpdateEvent
blockProducers' <- addNewBlockProducers blockProducers blocks' <- addNewBlocks blocks
(blocks, blockProducers'') <- runBlocks blockProducers' (blockOutputs, blocks'') <- runBlocks blocks'
currentBarOutput <- renderLine options handle blockFilter blocks previousBarOutput' currentBarOutput <- renderLine options handle blockFilter blockOutputs previousBarOutput'
-- Wait for 100ms after rendering a line to limit cpu load of rapid events -- Wait for 100ms after rendering a line to limit cpu load of rapid events
threadDelay 100000 threadDelay 100000
renderLoop' currentBarOutput blockProducers'' renderLoop' currentBarOutput blocks''
renderLine :: MainOptions -> Handle -> Filter -> [BlockOutput] -> BS.ByteString -> IO BS.ByteString renderLine :: MainOptions -> Handle -> Filter -> [BlockOutput] -> BS.ByteString -> IO BS.ByteString
renderLine MainOptions{verbose} Handle{handleActionList} blockFilter blocks previousEncodedOutput = do renderLine MainOptions{verbose} Handle{handleActionList} blockFilter blocks previousEncodedOutput = do
...@@ -181,16 +181,16 @@ runBarConfiguration generateBarConfig options = do ...@@ -181,16 +181,16 @@ runBarConfiguration generateBarConfig options = do
-- Create and initialzie blocks -- Create and initialzie blocks
(barUpdateChannel, barUpdateEvent) <- createBarUpdateChannel (barUpdateChannel, barUpdateEvent) <- createBarUpdateChannel
blockProducers <- toListM $ generateBarConfig barUpdateChannel blocks <- toListM $ generateBarConfig barUpdateChannel
-- Attach spinner indicator when verbose flag is set -- Attach spinner indicator when verbose flag is set
let blockProducers' = if indicator options then (renderIndicator:blockProducers) else blockProducers let blocks' = if indicator options then (renderIndicator:blocks) else blocks
-- Create channel to send new block producers to render loop -- Create channel to send new block producers to render loop
newBlockProducers <- newTChanIO newBlocks <- newTChanIO
-- Send initial block producers to render loop -- Send initial block producers to render loop
forM_ blockProducers' $ \ bp -> atomically $ writeTChan newBlockProducers bp forM_ blocks' $ \ bp -> atomically $ writeTChan newBlocks bp
-- Install signal handler for SIGCONT -- Install signal handler for SIGCONT
installSignalHandlers barUpdateChannel installSignalHandlers barUpdateChannel
...@@ -208,7 +208,7 @@ runBarConfiguration generateBarConfig options = do ...@@ -208,7 +208,7 @@ runBarConfiguration generateBarConfig options = do
updateBar barUpdateChannel updateBar barUpdateChannel
link socketUpdateAsync link socketUpdateAsync
renderLoop options handle barUpdateEvent initialOutput newBlockProducers renderLoop options handle barUpdateEvent initialOutput newBlocks
createCommandChan :: IO CommandChan createCommandChan :: IO CommandChan
createCommandChan = newTChanIO createCommandChan = newTChanIO
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment