diff options
Diffstat (limited to 'app/Ui.hs')
| -rw-r--r-- | app/Ui.hs | 26 |
1 files changed, 17 insertions, 9 deletions
@@ -23,6 +23,7 @@ module Ui ) where +import Control.DeepSeq import Control.Monad.Reader import Control.Monad.State (evalStateT, get, modify) import Data.Default @@ -35,12 +36,21 @@ import Graphics.X11.Xft qualified as X import Graphics.X11.Xrender qualified as X import Pretty qualified as P -data Ui a = Ui [a] deriving (Eq, Functor, Foldable, Traversable, Show) +data Ui a = Ui [a] + deriving + ( Eq, + Functor, + Foldable, + Traversable, + Show, + Generic, + NFData + ) data Block a = Lit a | Fill - deriving (Eq, Functor, Show) + deriving (Eq, Functor, Show, Generic, NFData) lit :: (P.Pretty a) => a -> Block P.Doc lit = Lit . P.pretty @@ -48,10 +58,8 @@ lit = Lit . P.pretty fill :: Block a fill = Fill -pollUi :: - Ui (S.Sensor (S.SensorT IO) () (Block P.Doc)) -> - S.Sensor (S.SensorT IO) () (Ui (Block P.Doc)) -pollUi = sequence +pollUi :: Ui (S.Sensor () (Block P.Doc)) -> S.Sensor () (Ui (Block P.Doc)) +pollUi (Ui sfs) = Ui <$> S.concatS sfs layOutUi :: Env -> Ui (Block P.Doc) -> IO Ui' layOutUi env (Ui bs) = layOut env (Ui' (concatMap go bs)) @@ -146,7 +154,7 @@ renderUi' env@Env {..} colors (Ui' cs') ui@(Ui' cs) X.xftDrawRect drw bg rect.left 0 rect.width wheight X.xftDrawString drw fg fnt rect.left h string -data Ui' = Ui' [C] deriving (Show) +data Ui' = Ui' [C] deriving (Show, Generic, NFData) data C = C { rect :: Rect, @@ -154,7 +162,7 @@ data C = C color :: Maybe (P.Intensity, P.Color), string :: String } - deriving (Show, Eq) + deriving (Show, Eq, Generic, NFData) data Rect = Rect { top :: Int, @@ -162,7 +170,7 @@ data Rect = Rect width :: Int, height :: Int } - deriving (Generic, Default, Show, Eq) + deriving (Generic, Default, Show, Eq, NFData) io :: (MonadIO m) => IO a -> m a io = liftIO |