diff options
Diffstat (limited to 'app/Sensor.hs')
-rw-r--r-- | app/Sensor.hs | 68 |
1 files changed, 44 insertions, 24 deletions
diff --git a/app/Sensor.hs b/app/Sensor.hs index 2342807..7d9324b 100644 --- a/app/Sensor.hs +++ b/app/Sensor.hs @@ -45,6 +45,7 @@ import Graphics.X11.Xlib.Extras qualified as X import Pretty qualified as P import Process.Shell (sh) import Safe +import System.Directory import System.FilePath import System.IO.Error import System.Linux.Inotify qualified as I @@ -126,14 +127,17 @@ cpu = transform "cpu" f cpu' data IoStat = IoStat {unIoStat :: Int} deriving (Show, Eq) ioStat :: Sensor IoStat -ioStat = pollFile "ioStat" aggregate "/sys/block/nvme0n1/stat" (5 * 10 ^ 5) +ioStat = poll' "ioStat" aggregate (5 * 10 ^ 5) where - aggregate fp = liftIO do - stat <- readFile fp + aggregate = liftIO do + fmap (IoStat . sum) . mapM (aggregate' . ("/sys/block" </>)) + =<< listDirectory "/sys/block" + aggregate' fp = do + stat <- readFile (fp </> "stat") case words stat of [_, _, read', _, _, _, write', _, _, _, _, _, _, _, _, _, _] -> - pure (IoStat ((read read') + (read write'))) - _ -> error "/sys/block/nvme0n1/stat: malformed" + pure (read read' + read write') + _ -> error (printf "%s/stat: malformed" fp) io' :: Sensor [IoStat] io' = histogram "io'" [] (\b a -> take 7 (a : b)) ioStat @@ -159,19 +163,15 @@ io = transform "io" f io' data NetStat = NetStat {unNetStat :: Int} deriving (Show, Eq) netStat :: Sensor NetStat -netStat = - pollFile - "netStat" - aggregate - "/sys/class/net/wlan0/statistics/rx_bytes" - (5 * 10 ^ 5) +netStat = poll' "netStat" aggregate (5 * 10 ^ 5) where - aggregate fp = liftIO do - NetStat - <$> ( (+) - <$> (read <$> readFile fp) - <*> (read <$> readFile (takeDirectory fp </> "tx_bytes")) - ) + aggregate = liftIO do + is <- listDirectory "/sys/class/net" + NetStat . sum <$> mapM (aggregate' . ("/sys/class/net" </>)) is + aggregate' fp = do + (+) + <$> (read <$> readFile (fp </> "statistics/rx_bytes")) + <*> (read <$> readFile (fp </> "statistics/tx_bytes")) net' :: Sensor [NetStat] net' = histogram "net'" [] (\b a -> take 7 (a : b)) netStat @@ -227,14 +227,24 @@ mem = transform "mem" (\(map unMemStat -> xs) -> pure (Mem xs)) mem' data BatStat = BatStat {unBatStat :: Float} deriving (Show, Eq) batStat :: Sensor BatStat -batStat = pollFile "batStat" aggregate "/sys/class/power_supply/macsmc-battery/charge_now" (5 * 10 ^ 5) +batStat = poll' "batStat" aggregate (5 * 10 ^ 5) where - aggregate fp = liftIO do - BatStat - <$> ( (\now full -> fromIntegral now / fromIntegral full) - <$> (read <$> readFile fp) - <*> (read <$> readFile (takeDirectory fp </> "charge_full")) - ) + aggregate = liftIO do + fmap (BatStat . product) . mapM (aggregate' . ("/sys/class/power_supply" </>)) + =<< listDirectory "/sys/class/power_supply" + aggregate' fp = + choice 1 $ + [ (/) + <$> (read <$> readFile (fp </> "charge_now")) + <*> (read <$> readFile (fp </> "charge_full")), + (/) + <$> (read <$> readFile (fp </> "energy_now")) + <*> (read <$> readFile (fp </> "energy_full")) + ] + +choice :: a -> [IO a] -> IO a +choice def [] = pure def +choice def (x : xs) = x `catch` (\(_ :: SomeException) -> choice def xs) bat' :: Sensor [BatStat] bat' = histogram "bat'" [] (\b a -> take 7 (a : b)) batStat @@ -434,6 +444,16 @@ pollFile id aggregate fp delay = Sensor id $ memoizeMVar do atomically (writeTVar stateT x) pure stateT +poll' :: String -> SensorM a -> Int -> Sensor a +poll' id aggregate delay = Sensor id $ memoizeMVar do + stateT <- newTVarIO =<< aggregate + void $ forkIO $ forever do + -- liftIO (printf "[%s] aggregate\n" id) + x <- aggregate + threadDelay delay + atomically (writeTVar stateT x) + pure stateT + watchXPropertyChanges :: String -> [String] -> |