diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs index f3d131b2d1a2198a7c1ab099c92fc8cc607c6efd..2e765229d1b379b333c847a5354265cfcb1a5d14 100644 --- a/src/QBar/Core.hs +++ b/src/QBar/Core.hs @@ -48,14 +48,11 @@ data CachedMode = CachedMode -- |Block that 'yield's an update whenever the block should be changed -type PushBlock = PushBlockProducer -type PushBlockProducer = Producer BlockOutput IO PushMode +type PushBlock = Producer BlockOutput IO PushMode -- |Block that generates an update on 'yield'. Should only be pulled when an update is required. -type PullBlock = PullBlockProducer -type PullBlockProducer = Producer BlockOutput IO PullMode +type PullBlock = Producer BlockOutput IO PullMode -- |Cached block. Always 'yield's the latest update, so it should only be pulled when the bar is rendered. -type CachedBlock = CachedBlockProducer -type CachedBlockProducer = Producer BlockOutput IO CachedMode +type CachedBlock = Producer BlockOutput IO CachedMode class IsBlock a where toCachedBlock :: BarUpdateChannel -> a -> CachedBlock @@ -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. sharedInterval :: BarUpdateChannel -> Int -> IO (PullBlock -> CachedBlock, Async ()) sharedInterval barUpdateChannel seconds = do - clientsMVar <- newMVar ([] :: [(MVar PullBlockProducer, Output BlockOutput)]) + clientsMVar <- newMVar ([] :: [(MVar PullBlock, Output BlockOutput)]) task <- async $ forever $ do threadDelay $ seconds * 1000000 @@ -197,11 +194,11 @@ sharedInterval barUpdateChannel seconds = do return (addClient clientsMVar, task) 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 result <- runClient client 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) = modifyMVar blockProducerMVar $ \blockProducer -> do result <- next blockProducer @@ -228,7 +225,7 @@ sharedInterval barUpdateChannel seconds = do void $ runClient (blockProducerMVar, output) -- Notify bar about changed block state, this is usually done by the shared interval handler updateBar barUpdateChannel - addClient :: MVar [(MVar PullBlockProducer, Output BlockOutput)] -> PullBlockProducer -> CachedBlock + addClient :: MVar [(MVar PullBlock, Output BlockOutput)] -> PullBlock -> CachedBlock addClient clientsMVar blockProducer = do -- Spawn the mailbox that preserves the latest block (output, input) <- lift $ spawn $ latest emptyBlock diff --git a/src/QBar/Server.hs b/src/QBar/Server.hs index c5769ed4e7928b7dd094405bd997c00a4ef0c61d..faf64601c94d4edd047914fb14a1377f9bce7a51 100644 --- a/src/QBar/Server.hs +++ b/src/QBar/Server.hs @@ -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). renderIndicator = forever $ each $ map createBlock ["/", "-", "\\", "|"] -runBlock :: CachedBlockProducer -> IO (Maybe (BlockOutput, CachedBlockProducer)) +runBlock :: CachedBlock -> IO (Maybe (BlockOutput, CachedBlock)) runBlock producer = do next' <- next producer return $ case next' of Left _ -> Nothing Right (block, newProducer) -> Just (block, newProducer) -runBlocks :: [CachedBlockProducer] -> IO ([BlockOutput], [CachedBlockProducer]) -runBlocks blockProducers = unzip . catMaybes <$> mapM runBlock blockProducers +runBlocks :: [CachedBlock] -> IO ([BlockOutput], [CachedBlock]) +runBlocks block = unzip . catMaybes <$> mapM runBlock block renderLoop :: MainOptions -> Handle -> BarUpdateEvent -> BS.ByteString -> TChan CachedBlock -> IO () renderLoop options handle@Handle{handleActiveFilter} barUpdateEvent previousBarOutput newBlockChan = renderLoop' previousBarOutput [] where - addNewBlockProducers :: [CachedBlock] -> IO [CachedBlock] - addNewBlockProducers blockProducers = do + addNewBlocks :: [CachedBlock] -> IO [CachedBlock] + addNewBlocks blocks = do maybeNewBlock <- atomically $ tryReadTChan newBlockChan case maybeNewBlock of - Nothing -> return blockProducers - Just newBlock -> addNewBlockProducers (newBlock:blockProducers) + Nothing -> return blocks + Just newBlock -> addNewBlocks (newBlock:blocks) renderLoop' :: BS.ByteString -> [CachedBlock] -> IO () - renderLoop' previousBarOutput' blockProducers = do + renderLoop' previousBarOutput' blocks = do blockFilter <- readIORef handleActiveFilter -- Wait for an event (unless the filter is animated) @@ -67,16 +67,16 @@ renderLoop options handle@Handle{handleActiveFilter} barUpdateEvent previousBarO threadDelay 10000 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 threadDelay 100000 - renderLoop' currentBarOutput blockProducers'' + renderLoop' currentBarOutput blocks'' renderLine :: MainOptions -> Handle -> Filter -> [BlockOutput] -> BS.ByteString -> IO BS.ByteString renderLine MainOptions{verbose} Handle{handleActionList} blockFilter blocks previousEncodedOutput = do @@ -181,16 +181,16 @@ runBarConfiguration generateBarConfig options = do -- Create and initialzie blocks (barUpdateChannel, barUpdateEvent) <- createBarUpdateChannel - blockProducers <- toListM $ generateBarConfig barUpdateChannel + blocks <- toListM $ generateBarConfig barUpdateChannel -- 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 - newBlockProducers <- newTChanIO + newBlocks <- newTChanIO -- 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 installSignalHandlers barUpdateChannel @@ -208,7 +208,7 @@ runBarConfiguration generateBarConfig options = do updateBar barUpdateChannel link socketUpdateAsync - renderLoop options handle barUpdateEvent initialOutput newBlockProducers + renderLoop options handle barUpdateEvent initialOutput newBlocks createCommandChan :: IO CommandChan createCommandChan = newTChanIO