diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Main.hs | 2 | ||||
| -rw-r--r-- | app/Pretty.hs | 7 | ||||
| -rw-r--r-- | app/Sensor.hs | 125 |
3 files changed, 89 insertions, 45 deletions
diff --git a/app/Main.hs b/app/Main.hs index 42ce113..aadae2d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -193,7 +193,7 @@ createWindow args = do [pure (lit (if args.icons then "\xf1638 " else "io ")), lit <$> io], [pure (lit (if args.icons then "\xf0200 " else "net ")), lit <$> net], [pure (lit " "), lit <$> Sensor.snd], - [pure (lit " "), lit <$> bat], + [pure (lit " "), lit <$> bat], [pure (lit " "), lit <$> weatherForecast], [pure (lit " "), lit <$> date, pure (lit ", "), lit <$> time], [] diff --git a/app/Pretty.hs b/app/Pretty.hs index 07b3296..7732dae 100644 --- a/app/Pretty.hs +++ b/app/Pretty.hs @@ -14,6 +14,7 @@ module Pretty ) where +import Data.Monoid import Pretty.Color data Doc @@ -24,6 +25,12 @@ data Doc class Pretty a where pretty :: a -> Doc +instance (Monoid Doc) where + mempty = Col [] + +instance (Semigroup Doc) where + a <> b = Col [a, b] + instance Pretty Doc where pretty = id 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) |