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 | |
-} |
@lilydjwg, new revision requires text-format
package . Further optimization may include: using conduit
(though in my computational heavy projects, this does not make much difference from current simple hand written impl with text
( I even use print/show, but not read )
@przhu, text-format is not in ArchHaskell repo :-(
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
@przhu, This version is 5.6% faster (589ms vs 624ms, 20 times average) :-)
but still slower than Python version which is 571ms.