From 1083d34c8563d3ce200f2f363ce36b19bf792f6f Mon Sep 17 00:00:00 2001
From: Fabian Kirchner <kirchner@posteo.de>
Date: Tue, 13 Aug 2024 10:21:00 +0200
Subject: feat: show batteries separately and correct state

---
 app/Sensor.hs | 125 +++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 81 insertions(+), 44 deletions(-)

(limited to 'app/Sensor.hs')

diff --git a/app/Sensor.hs b/app/Sensor.hs
index 8c984f8..e5fd50f 100644
--- a/app/Sensor.hs
+++ b/app/Sensor.hs
@@ -199,28 +199,24 @@ data BatState
   = NotCharging
   | Charging
   | Discharging
+  deriving (Generic, Eq, NFData, Show)
+
+data BatType
+  = Mains
+  | Bat
+  | USB
   deriving (Generic, Eq, NFData)
 
-instance (S.MonadSensor m) => S.Aggregate m BatStat (Float, BatState) where
+instance (S.MonadSensor m) => S.Aggregate m BatStat [(Float, BatState, BatType)] where
   aggregate _ = forever do S.yield =<< parse <* sleep
     where
       parse = liftIO do
-        fmap combine
-          . mapM (parse1 . ("/sys/class/power_supply" </>))
+        mapM (parse1 . ("/sys/class/power_supply" </>))
           =<< listDirectory "/sys/class/power_supply"
-      combine abs =
-        ( product (map fst abs),
-          if any ((==) Discharging) (map Prelude.snd abs)
-            then Discharging
-            else
-              if any ((==) Charging) (map Prelude.snd abs)
-                then Charging
-                else NotCharging
-        )
-      parse1 :: FilePath -> IO (Float, BatState)
+      parse1 :: FilePath -> IO (Float, BatState, BatType)
       parse1 fp =
-        liftM2
-          (,)
+        liftM3
+          (,,)
           ( choice 1 $
               [ (/)
                   <$> (readFile (fp </> "charge_now") (pure . read))
@@ -231,36 +227,75 @@ instance (S.MonadSensor m) => S.Aggregate m BatStat (Float, BatState) where
               ]
           )
           (choice NotCharging [readFile (fp </> "status") (pure . parseBatState . map toLower)])
-      parseBatState :: String -> BatState
-      parseBatState string =
-        case string of
-          "not charging" ->
-            NotCharging
-          "charging" ->
-            Charging
-          "discharging" ->
-            Discharging
-          _ ->
-            error ("invalid bat state: " ++ string)
+          (choice Mains [readFile (fp </> "type") (pure . parseBatType . map toLower)])
+
+parseBatState :: String -> BatState
+parseBatState string =
+  case strip string of
+    "not charging" -> NotCharging
+    "charging" -> Charging
+    "discharging" -> Discharging
+    _ -> error ("invalid bat state: " ++ string)
+
+parseBatType :: String -> BatType
+parseBatType string =
+  case strip string of
+    "mains" -> Mains
+    "battery" -> Bat
+    "usb" -> USB
+    _ -> error ("invalid bat type: " ++ string)
 
 bat :: (S.MonadSensor m) => S.Sensor m () P.Doc
-bat =
-  S.sensor BatStat >>= \(value, batState) ->
-    case batState of
-      Charging ->
-        if
-          | value >= 0.9 -> pure (P.pretty "\xf0085")
-          | value >= 0.8 -> pure (P.pretty "\xf008b")
-          | value >= 0.7 -> pure (P.pretty "\xf008a")
-          | value >= 0.6 -> pure (P.pretty "\xf089e")
-          | value >= 0.5 -> pure (P.pretty "\xf0089")
-          | value >= 0.4 -> pure (P.pretty "\xf089d")
-          | value >= 0.3 -> pure (P.pretty "\xf0088")
-          | value >= 0.2 -> pure (P.pretty "\xf0087")
-          | value >= 0.1 -> pure (P.pretty "\xf0086")
-          | otherwise -> pure (P.pretty "\xf089c")
-      _ ->
-        if
+bat = do
+  bats <- S.sensor BatStat
+  fmap mconcat $ sequence $ intersperse (pure (P.pretty " ")) $ map printBat $ filter isBat bats
+  where
+    isBat (_, _, batType) =
+      batType == Bat
+    printBat :: (S.MonadSensor m) => (Float, BatState, BatType) -> S.Sensor m () P.Doc
+    printBat (value, batState, _) =
+      case batState of
+        NotCharging ->
+          pure (printBatNotCharging value)
+        Charging ->
+          pure (printBatCharging value)
+        Discharging ->
+          printBatDischarging value
+
+printBatNotCharging :: Float -> P.Doc
+printBatNotCharging value =
+  if
+    | value >= 0.95 -> P.pretty "\xf0079"
+    | value >= 0.9 -> P.pretty "\xf0082"
+    | value >= 0.8 -> P.pretty "\xf0081"
+    | value >= 0.7 -> P.pretty "\xf0080"
+    | value >= 0.6 -> P.pretty "\xf007f"
+    | value >= 0.5 -> P.pretty "\xf007e"
+    | value >= 0.4 -> P.pretty "\xf007d"
+    | value >= 0.3 -> P.pretty "\xf007c"
+    | value >= 0.2 -> P.pretty "\xf007b"
+    | value >= 0.1 -> P.pretty "\xf007a"
+    | otherwise -> P.pretty "\xf008e"
+
+printBatCharging :: Float -> P.Doc
+printBatCharging value =
+  if
+    | value >= 0.9 -> P.pretty "\xf0085"
+    | value >= 0.8 -> P.pretty "\xf008b"
+    | value >= 0.7 -> P.pretty "\xf008a"
+    | value >= 0.6 -> P.pretty "\xf089e"
+    | value >= 0.5 -> P.pretty "\xf0089"
+    | value >= 0.4 -> P.pretty "\xf089d"
+    | value >= 0.3 -> P.pretty "\xf0088"
+    | value >= 0.2 -> P.pretty "\xf0087"
+    | value >= 0.1 -> P.pretty "\xf0086"
+    | otherwise -> P.pretty "\xf089c"
+
+printBatDischarging :: (S.MonadSensor m) => Float -> S.Sensor m () P.Doc
+printBatDischarging value =
+  fmap mconcat $
+    sequence
+      [ if
           | value >= 0.95 -> pure (P.pretty "\xf0079")
           | value >= 0.9 -> pure (P.pretty "\xf0082")
           | value >= 0.8 -> pure (P.pretty "\xf0081")
@@ -273,7 +308,9 @@ bat =
           | value >= 0.1 -> pure (P.pretty "\xf007a")
           | otherwise ->
               (\b -> if b then P.pretty "\xf008e" else (P.color P.Red) (P.pretty "\xf0083"))
-                <$> blink
+                <$> blink,
+        pure (P.pretty "\xf433")
+      ]
 
 data Blink = Blink deriving (Show)
 
-- 
cgit v1.2.3