fix: depend on sensors

1 files changed, 13 insertions, 46 deletions

diff --git a/app/Ui.hs b/app/Ui.hs
index fa1b38e..808c3c1 100644
--- a/app/Ui.hs
+++ b/app/Ui.hs
@@ -11,10 +11,9 @@
 
 module Ui
   ( Ui (Ui),
+    Block,
     lit,
     fill,
-    sens,
-    initUi,
     pollUi,
     Env (..),
     Ui',
@@ -24,72 +23,40 @@ module Ui
   )
 where
 
-import Control.Concurrent.STM
-import Control.Monad.Identity
 import Control.Monad.Reader
 import Control.Monad.State (evalStateT, get, modify)
 import Data.Default
-import Data.Dynamic
 import Data.Map qualified as M
 import Data.Maybe
+import Data.Sensor qualified as S
 import GHC.Generics (Generic)
 import Graphics.X11 qualified as X
 import Graphics.X11.Xft qualified as X
 import Graphics.X11.Xrender qualified as X
 import Pretty qualified as P
-import Sensor hiding (io)
 
-data Ui f a = Ui [Block f a]
+data Ui a = Ui [a] deriving (Eq, Functor, Foldable, Traversable, Show)
 
-instance Eq (Ui Identity P.Doc) where
-  Ui bs == Ui bs' = bs == bs'
-
-data Block f a
-  = Lit P.Doc
+data Block a
+  = Lit a
   | Fill
-  | forall o. (Typeable o) => Sens (o -> a) (f o)
-
-instance Eq (Block Identity P.Doc) where
-  (Lit doc) == (Lit doc') = doc == doc'
-  Fill == Fill = True
-  Sens toOut (Identity x) == Sens toOut' (Identity x') = toOut x == toOut' x'
-  _ == _ = False
+  deriving (Eq, Functor, Show)
 
-lit :: (P.Pretty a) => a -> Block f P.Doc
+lit :: (P.Pretty a) => a -> Block P.Doc
 lit = Lit . P.pretty
 
-fill :: Block f a
+fill :: Block a
 fill = Fill
 
-sens :: (P.Pretty o, Typeable o) => f o -> Block f P.Doc
-sens = Sens P.pretty
-
-initUi ::
-  Ui Sensor P.Doc ->
-  SensorM (Ui TVar P.Doc)
-initUi (Ui bs) = Ui <$> mapM go bs
-  where
-    go (Lit s) = pure (Lit s)
-    go Fill = pure Fill
-    go (Sens toOut s) = Sens toOut <$> poll s
-
 pollUi ::
-  Ui TVar P.Doc ->
-  STM (Ui Identity P.Doc)
-pollUi (Ui bs) = Ui <$> mapM go bs
-  where
-    go (Lit s) = pure (Lit s)
-    go Fill = pure Fill
-    go (Sens toOut vT) = Sens toOut . Identity <$> readTVar vT
-
-layOutUi ::
-  Env ->
-  Ui Identity P.Doc ->
-  IO Ui'
+  Ui (S.Sensor (S.SensorT IO) () (Block P.Doc)) ->
+  S.Sensor (S.SensorT IO) () (Ui (Block P.Doc))
+pollUi = sequence
+
+layOutUi :: Env -> Ui (Block P.Doc) -> IO Ui'
 layOutUi env (Ui bs) = layOut env (Ui' (concatMap go bs))
   where
     go (Lit doc) = go' doc
-    go (Sens toOut (runIdentity -> toOut -> doc)) = go' doc
     go Fill =
       [ C
           { rect = def,