Print swap memory used by each process

swap.hs

{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C
import Prelude hiding (readFile)
import System.Directory
import System.Exit
import System.FilePath
import System.IO hiding (readFile)

proc = "/proc"

failWhen :: IO Bool -> String -> IO ()
failWhen cond msg = do
  res <- cond
  when res $ hPutStrLn stderr ("error: " ++ msg) >> exitFailure

readFile :: FilePath -> IO ByteString
readFile f = bracket (openBinaryFile f ReadMode) hClose C.hGetContents

getProcessName :: FilePath -> IO ByteString
getProcessName pidDir = do
  let procNameFile = pidDir </> "comm"
  failWhen (not <$> doesFileExist procNameFile) ("Cannot open file " ++ procNameFile)
  C.init <$> readFile procNameFile

getSwapUsed :: FilePath -> IO Int
getSwapUsed pidDir = do
  let swapFile = pidDir </> "smaps"
  failWhen (not <$> doesFileExist swapFile) ("Cannot open file " ++ swapFile)
  fileContent <- (filter (C.isPrefixOf "Swap") . C.lines) <$> readFile swapFile
  return $ sum $ for fileContent $
    read . C.unpack . C.takeWhile isDigit . C.dropWhile (not . isDigit)
  where for = flip map

main :: IO ()
main = do
  failWhen (not <$> doesDirectoryExist proc) ("Cannot access " ++ proc)
  pids <- filter (all isDigit) <$> getDirectoryContents proc
  forM_ pids $ \pid -> do
    let pidDir = proc </> pid
    pidDirExist <- doesDirectoryExist pidDir
    if pidDirExist
      then do
        processName <- getProcessName pidDir
        swapUsed <- getSwapUsed pidDir
        C.putStrLn $ C.pack pid `C.append` " " `C.append` processName
                                `C.append` " " `C.append` C.pack (show swapUsed)
      else putStrLn $ pidDir ++ " is not a valid directory, ignoring"