diff options
| -rw-r--r-- | app/Sensor.hs | 154 |
1 files changed, 86 insertions, 68 deletions
diff --git a/app/Sensor.hs b/app/Sensor.hs index be11e2f..4aad7b2 100644 --- a/app/Sensor.hs +++ b/app/Sensor.hs @@ -200,7 +200,13 @@ memStat = S.sensor (\() -> "memStat") $ \() yield -> forever do mem :: S.Sensor () (P.Diagram [Float]) mem = diagram 3 memStat -data BatStat = BatStat deriving (Show) +data BatStat = BatStat + { name :: String, + charge :: Float, + status :: BatState, + type_ :: BatType + } + deriving (Show, Generic, NFData, Eq) data BatState = NotCharging @@ -214,16 +220,16 @@ data BatType | USB deriving (Show, Generic, Eq, NFData) -batStat :: S.Sensor () [(Float, BatState, BatType)] -batStat = S.sensor (\() -> "batStat") $ \() yield -> forever do yield =<< parse <* sleep +batStat :: S.Sensor () [BatStat] +batStat = S.sensor (\() -> "batStat") $ \() yield -> forever do + yield =<< parse <* sleep where parse = liftIO do mapM (parse1 . ("/sys/class/power_supply" </>)) =<< listDirectory "/sys/class/power_supply" - parse1 :: FilePath -> IO (Float, BatState, BatType) parse1 fp = liftM3 - (,,) + (BatStat (map toLower (takeBaseName fp))) ( choice 1 $ [ (/) <$> (readFile (fp </> "charge_now") (pure . read)) @@ -233,8 +239,14 @@ batStat = S.sensor (\() -> "batStat") $ \() yield -> forever do yield =<< parse <*> (readFile (fp </> "energy_full") (pure . read)) ] ) - (choice NotCharging [readFile (fp </> "status") (pure . parseBatState . map toLower)]) - (choice Mains [readFile (fp </> "type") (pure . parseBatType . map toLower)]) + ( choice + NotCharging + [readFile (fp </> "status") (pure . parseBatState . map toLower)] + ) + ( choice + Mains + [readFile (fp </> "type") (pure . parseBatType . map toLower)] + ) parseBatState :: String -> BatState parseBatState string = @@ -252,75 +264,81 @@ parseBatType string = "usb" -> USB _ -> error ("invalid bat type: " ++ string) +batIcon :: S.Sensor () P.Doc +batIcon = batWith printBat + where + printBat isOn batStat = + P.pretty + case batStat.status of + NotCharging -> + P.pretty (printBatCapacity batStat.charge <> " ") + Charging -> + P.pretty (printBatCapacity batStat.charge <> nfOctArrowUp) + Discharging -> + if batStat.charge < 0.1 + then + ( if isOn + then + P.color P.Red + else + (\x -> x) + ) + ( P.pretty + ( if isOn + then printBatCapacity batStat.charge <> nfOctArrowDown + else "\xf0083" <> nfOctArrowDown + ) + ) + else P.pretty (printBatCapacity batStat.charge <> nfOctArrowDown) + + printBatCapacity value = + if + | value >= 0.95 -> "\xf0079" + | value >= 0.9 -> "\xf0082" + | value >= 0.8 -> "\xf0081" + | value >= 0.7 -> "\xf0080" + | value >= 0.6 -> "\xf007f" + | value >= 0.5 -> "\xf007e" + | value >= 0.4 -> "\xf007d" + | value >= 0.3 -> "\xf007c" + | value >= 0.2 -> "\xf007b" + | value >= 0.1 -> "\xf007a" + | otherwise -> "\xf008e" + + nfOctArrowUp = "\xf431 " + nfOctArrowDown = "\xf433 " + bat :: S.Sensor () P.Doc -bat = proc () -> do +bat = + batWith + ( \isOn batStat -> + ( if (batStat.charge <= 0.15) && isOn + then + P.color P.Red + else + (\x -> x) + ) + ( P.pretty + ( case batStat.status of + Charging -> init batStat.name ++ "+" + Discharging -> init batStat.name ++ "-" + NotCharging -> batStat.name + ) + <> P.pretty (P.diagram 1 [batStat.charge]) + ) + ) + +batWith :: (P.Pretty a) => (Bool -> BatStat -> a) -> S.Sensor () P.Doc +batWith f = proc () -> do bats <- batStat -< () isOn <- blink -< () returnA -< mconcat . intersperse (P.pretty " ") - . map (printBat isOn) - . filter isBat + . map (P.pretty . (f isOn)) + . filter ((==) Bat . (.type_)) $ bats - where - isBat (_, _, batType) = - batType == Bat - printBat isOn (value, batState, _) = - case batState of - NotCharging -> - printBatNotCharging value - Charging -> - printBatCharging value - Discharging -> - printBatDischarging isOn value - -printBatNotCharging :: Float -> P.Doc -printBatNotCharging value = - mconcat - [ printBatCapacity value, - P.pretty " " - ] - -printBatCharging :: Float -> P.Doc -printBatCharging value = - mconcat - [ printBatCapacity value, - nfOctArrowUp - ] - -printBatDischarging :: Bool -> Float -> P.Doc -printBatDischarging isOn value = - if value < 0.1 - then - if isOn - then mconcat [printBatCapacity value, nfOctArrowDown] - else (P.color P.Red) (mconcat [P.pretty "\xf0083", nfOctArrowDown]) - else (mconcat [printBatCapacity value, nfOctArrowDown]) - -printBatCapacity :: Float -> P.Doc -printBatCapacity value = - P.pretty $ - if - | value >= 0.95 -> "\xf0079" - | value >= 0.9 -> "\xf0082" - | value >= 0.8 -> "\xf0081" - | value >= 0.7 -> "\xf0080" - | value >= 0.6 -> "\xf007f" - | value >= 0.5 -> "\xf007e" - | value >= 0.4 -> "\xf007d" - | value >= 0.3 -> "\xf007c" - | value >= 0.2 -> "\xf007b" - | value >= 0.1 -> "\xf007a" - | otherwise -> "\xf008e" - -nfOctArrowUp :: P.Doc -nfOctArrowUp = - P.pretty "\xf431 " - -nfOctArrowDown :: P.Doc -nfOctArrowDown = - P.pretty "\xf433 " blink :: S.Sensor () Bool blink = S.sensor (\() -> "blink") (\() yield -> loop yield True) |