Last active
December 30, 2015 22:18
-
-
Save przhu/7892814 to your computer and use it in GitHub Desktop.
for lilydjwg , try it. It uses show as a simple repl. of filesize ( I do not have that). It is still quite slow (I believe) (currenly I do not have a linux machine to test it..)
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-} | |
import Control.Applicative ((<$>)) | |
import Control.Exception (catch, SomeException) | |
import Control.Monad (mapM) | |
import Data.Char (isDigit) | |
import Data.List (sortBy) | |
import qualified Data.Text as T | |
import qualified Data.Text.IO as T | |
import qualified Data.Text.Format as T | |
import Data.Text.Lazy(toStrict) | |
import Data.Text.Read(decimal) | |
import System.Directory (getDirectoryContents) | |
import Text.Printf (printf) | |
import Control.Arrow(second) | |
-- import Math.Number (filesize) | |
-- import Text.String (trChar) | |
filesize :: Int -> String | |
filesize = show | |
type Pid = T.Text | |
{- | |
format :: String | |
format = "%5s %9s %s" | |
totalFmt :: String | |
totalFmt = "Total: %8s" | |
-} | |
pidTitl :: T.Text | |
pidTitl = "PID" | |
swapTitl :: T.Text | |
swapTitl = "SWAP" | |
cmdTitl :: T.Text | |
cmdTitl = "COMMAND" | |
format _1 _2 _3 = toStrict $ T.format "{} {} {}" (b1, b2, b3) where | |
b1 = T.left 5 ' ' _1 | |
b2 = T.left 9 ' ' _2 | |
b3 = _3 | |
totalFmt _1 = toStrict $ T.format "Total: {}" (T.Only b1) where | |
b1 = T.left 8 ' ' _1 | |
main = do | |
ps <- pids | |
ss <- mapM swapusedNoExcept ps | |
let !t = 1024 * sum ss | |
r <- mapM formatResult (transformData (zip ps ss)) | |
let printResult = do | |
T.putStrLn $ format pidTitl swapTitl cmdTitl | |
T.putStr . T.unlines $ r | |
T.putStrLn $ totalFmt $ filesize t | |
printResult | |
where swapusedNoExcept !p = do | |
su <- catch (swapused p) (\(_::SomeException) -> return 0) | |
return $! su | |
pids :: IO [Pid] | |
pids = filter digitsOnly . map T.pack <$> getDirectoryContents "/proc" | |
where digitsOnly = T.all isDigit | |
swapused :: Pid -> IO Int | |
swapused pid = sum . map getNumber . filter (T.isPrefixOf "Swap:") . T.lines <$> | |
T.readFile (T.unpack $ "/proc/" `T.append` pid `T.append` "/smaps") | |
where getNumber line = | |
case T.dropWhile (not.isDigit) line of | |
t -> case decimal t of | |
(Right (n, _)) -> n | |
(Left _) -> 0 | |
transformData :: [(Pid, Int)] -> [(Pid, String)] | |
transformData = map (second humanSize) . | |
sortBy (\ (_, !x) (_, !y) -> compare x y) . | |
filter ((/=) 0 . snd) | |
where humanSize = filesize . (* 1024) | |
formatResult :: (Pid, String) -> IO T.Text | |
formatResult (pid, size) = do | |
cmd <- getCommand pid | |
return $ format pid size cmd | |
getCommand :: Pid -> IO T.Text | |
getCommand pid = T.strip <$> T.readFile (T.unpack $ "/proc/" `T.append` pid `T.append` "/cmdline") | |
{- | |
total :: [X Int] -> Int | |
total = sum . map _2 | |
-} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
@lilydjwg, new revision requires
text-format
package . Further optimization may include: usingconduit
(though in my computational heavy projects, this does not make much difference from current simple hand written impl withtext
( I even use print/show, but not read )