1 files changed, 21 insertions, 11 deletions
diff --git a/app/Sensor.hs b/app/Sensor.hs
index 2c2e860..de14783 100644
--- a/app/Sensor.hs
+++ b/app/Sensor.hs
@@ -114,16 +114,23 @@ diagram n sf = S.feedbackS [] $ proc ((), xs) -> do
   x <- sf -< ()
   returnA -< (P.diagram n (reverse (x : xs)), take (2 * (n - 1) + 1) (x : xs))
 
-thermal :: S.Sensor () String
-thermal = S.sensor (\() -> "thermal") $ \() yield -> forever do
-  yield . fmt =<< parse <* sleep
+thermal :: S.Sensor () (P.Diagram [Float])
+thermal =
+  ((\x -> clamp 0 1 (x / 100)) <$$$>) $
+    diagram 1 $
+      S.sensor (\() -> "thermal") $ \() yield -> forever do
+        yield =<< parse <* sleep
   where
     parse = liftIO do
       is <- listDirectory "/sys/class/thermal"
       maximum <$> mapM (parse1 . ("/sys/class/thermal" </>)) is
     parse1 fp = do
-      (choice 0 [readFile (fp </> "temp") (pure . read @Int . strip)])
-    fmt temp = (printf "%.1f" (fromIntegral temp / (1000 :: Float)))
+      (choice 0 [readFile (fp </> "temp") (pure . (/ 1000) . fromIntegral . read @Int . strip)])
+
+clamp :: (Ord a) => a -> a -> a -> a
+clamp hi lo
+  | hi > lo = min hi . max lo
+  | otherwise = clamp lo hi
 
 ioStat :: S.Sensor () Int
 ioStat = S.sensor (\() -> "ioStat") $ \() yield -> forever do
@@ -636,8 +643,8 @@ time =
     <$> currentTimeZone
     <*> currentTime
 
-wmName :: S.Sensor () String
-wmName = activeWindow >>> S.withDefaultS "" wmNameOf
+wmName :: S.Sensor () P.Doc
+wmName = activeWindow >>> S.withDefaultS (P.pretty "") wmNameOf
 
 data ActiveWindow = ActiveWindow deriving (Show)
 
@@ -682,7 +689,7 @@ activeWindow = do
             waitForEvent
       )
 
-wmNameOf :: S.Sensor X.Window String
+wmNameOf :: S.Sensor X.Window P.Doc
 wmNameOf =
   S.sensor
     (\win -> printf "wmNameOf %s" (show win))
@@ -716,7 +723,7 @@ wmNameOf =
                             waitForEvent
 
                   readWmName = do
-                    yield
+                    yield . P.color P.Magenta . P.pretty
                       =<< fmap (strip . head) . liftIO . X.wcTextPropertyToTextList dpy
                       =<< liftIO (X.getTextProperty dpy win netWmName)
               forever do
@@ -815,12 +822,15 @@ instance P.Pretty [Workspace] where
     P.Col . intersperse (P.pretty " ") . map P.pretty
 
 instance P.Pretty Workspace where
-  pretty (Active s) = P.color P.White (P.pretty s)
-  pretty (Inactive s) = P.color P.Cyan (P.pretty s)
+  pretty (Active s) = P.color P.Cyan (P.pretty s)
+  pretty (Inactive s) = P.color P.White (P.pretty s)
 
 (<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
 f <$$> x = fmap f <$> x
 
+(<$$$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
+f <$$$> x = fmap f <$$> x
+
 infixl 4 <$$>
 
 fi :: (Integral a, Num b) => a -> b