module Hi3Status.StatusLine (
startStatusLine,
Blocks,
BlocksEntry (),
(%%)
) where
import Hi3Status.Block
import Hi3Status.Block.Internal
import System.IO
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import qualified Data.ByteString.Lazy.Char8 as B
import Data.String
import DBus
import DBus.Client
import qualified Data.Aeson as A
data BlocksEntry where
BlocksEntry :: Block a => String -> a -> BlocksEntry
(%%) :: Block a => String -> a -> BlocksEntry
(%%) = BlocksEntry
infixl 7 %%
type Blocks = [BlocksEntry]
runBlocks :: Blocks -> Chan BlockUpdate -> IO [(String, MVar UpdateSignal)]
runBlocks bs c = mapM (\(n, BlocksEntry i b) -> do
u <- newMVar UpdateSignal
forkIO $ runBlockM (runBlock b) n u c
return (i,u)) . zip [0..] $ bs
receiveUpdates :: Chan BlockUpdate -> MV.IOVector BlockDescription -> IO ()
receiveUpdates c ds = do
BlockUpdate n d <- readChan c
MV.write ds n d
fds <- V.freeze ds
let jds = A.toJSON fds
out = A.encode jds
B.putStr out
putStr ","
receiveUpdates c ds
updateAll us = mapM_ (\(_,u) -> update u) us
startStatusLine :: Blocks -> IO ()
startStatusLine blocks = do
hSetBuffering stdout LineBuffering
putStr "{\"version\": 1, \"click_events\": true}["
updateChan <- newChan :: IO (Chan BlockUpdate)
blockDescriptions <- MV.replicate (length blocks) emptyBlockDescription :: IO (MV.IOVector BlockDescription)
namesUpdaters <- runBlocks blocks updateChan
client <- connectSession
requestName client "org.i3wm.hi3status" [nameAllowReplacement, nameReplaceExisting]
export client "/" [autoMethod "org.i3wm.hi3status" "UpdateAll" $ updateAll namesUpdaters]
mapM_ (\(name,updater) -> do
export client (fromString $ "/"++name) [autoMethod "org.i3wm.hi3status" "Update" $ update updater]
return ()) namesUpdaters
receiveUpdates updateChan blockDescriptions