{-| Module : Hi3Status.Block.Internal License : MIT Maintainer : Josh Kirklin (jjvk2@cam.ac.uk) Stability : experimental -} {-# LANGUAGE OverloadedStrings #-} module Hi3Status.Block.Internal where import Control.Concurrent import Control.Concurrent.Chan import Control.Concurrent.MVar import Control.Monad.IO.Class import qualified Data.Text as T import Data.String import qualified Data.Aeson as A import Data.Aeson ((.=)) data BlockUpdate = BlockUpdate { blockUpdatePosition :: Int , blockUpdateDescription :: BlockDescription } data UpdateSignal = UpdateSignal -- | 'BlockM' is a monad responsible for controlling the operation of a block. Each block has two lines of communication with the main status line: -- -- * The status line can tell the block that it needs updating. -- * The block can push updates in the form of 'BlockDescription's to the status line, which will then be processed and submitted to i3bar. data BlockM a = BlockM { runBlockM :: Int -> MVar UpdateSignal -> Chan BlockUpdate -> IO a } instance Functor BlockM where fmap f blockm = BlockM $ \p u c -> fmap f $ runBlockM blockm p u c instance Applicative BlockM where pure a = BlockM $ \_ _ _ -> return a (BlockM f) <*> (BlockM a) = BlockM $ \p u c -> (f p u c) <*> (a p u c) instance Monad BlockM where BlockM a >>= m = BlockM $ \p u c -> do a' <- a p u c runBlockM (m a') p u c return = pure fail e = BlockM $ \_ _ _ -> fail e instance MonadIO BlockM where liftIO io = BlockM $ \_ _ _ -> io update u = tryPutMVar u UpdateSignal >> return () data BlockAlign = AlignLeft | AlignCenter | AlignRight instance A.ToJSON BlockAlign where toJSON AlignLeft = A.String "left" toJSON AlignCenter = A.String "center" toJSON AlignRight = A.String "right" -- | A 'BlockDescription' contains everything needed by i3bar to properly render a block. This includes things like the text of a block, and the color of the text. For more information about each field, see the i3bar protocol at . data BlockDescription = BlockDescription { full_text :: T.Text , short_text :: Maybe T.Text , color :: Maybe T.Text , min_width :: Maybe Int , align :: Maybe BlockAlign , name :: Maybe T.Text , instanc :: Maybe T.Text , urgent :: Maybe Bool , separator :: Maybe Bool , separator_block_width :: Maybe Int , markup :: Maybe T.Text } instance A.ToJSON BlockDescription where toJSON d = A.object . filter ((/= A.Null) . snd) $ [ "full_text" .= full_text d , "short_text" .= short_text d , "color" .= color d , "min_width" .= min_width d , "align" .= align d , "name" .= name d , "instance" .= instanc d , "urgent" .= urgent d , "separator" .= separator d , "separator_block_width" .= separator_block_width d , "markup" .= markup d ] instance IsString BlockDescription where fromString str = emptyBlockDescription { full_text = fromString str } -- | An empty block description, i.e. one with @full_text = ""@, and everything else equal to @Nothing@. emptyBlockDescription = BlockDescription "" Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing