feat: critical battery blinks

2 files changed, 24 insertions, 11 deletions

diff --git a/app/Pretty.hs b/app/Pretty.hs
index d2988a9..8621a41 100644
--- a/app/Pretty.hs
+++ b/app/Pretty.hs
@@ -24,6 +24,9 @@ data Doc
 class Pretty a where
   pretty :: a -> Doc
 
+instance Pretty Doc where
+  pretty = id
+
 instance Pretty Char where
   pretty = pretty . (: [])
 
diff --git a/app/Sensor.hs b/app/Sensor.hs
index 0c05519..9ef38d0 100644
--- a/app/Sensor.hs
+++ b/app/Sensor.hs
@@ -207,17 +207,27 @@ instance (S.MonadSensor m) => S.Aggregate m BatStat Float where
               <*> (readFile (fp </> "energy_full") (pure . read))
           ]
 
-bat :: (S.MonadSensor m) => S.Sensor m () String
-bat = do
-  value <- S.sensor BatStat
-  return
-    ( if
-        | 0.8 < value -> "\xf240"
-        | 0.6 < value -> "\xf241"
-        | 0.4 < value -> "\xf242"
-        | 0.2 < value -> "\xf243"
-        | otherwise -> "\xf244"
-    )
+bat :: (S.MonadSensor m) => S.Sensor m () P.Doc
+bat =
+  S.sensor BatStat >>= \value ->
+    if
+      | value >= 0.8 -> pure (P.pretty "\xf240 ")
+      | value >= 0.6 -> pure (P.pretty "\xf241 ")
+      | value >= 0.4 -> pure (P.pretty "\xf242 ")
+      | value >= 0.2 -> pure (P.pretty "\xf243 ")
+      | otherwise ->
+          (\b -> (if b then id else (P.color P.Red)) (P.pretty "\xf244 "))
+            <$> blink
+
+data Blink = Blink deriving (Show)
+
+blink :: (S.MonadSensor m) => S.Sensor m () Bool
+blink = S.sensor Blink
+
+instance (S.MonadSensor m) => S.Aggregate m Blink Bool where
+  aggregate _ = loop True
+    where
+      loop b = S.yield b >> sleep >> loop (not b)
 
 choice :: a -> [IO a] -> IO a
 choice def [] = pure def