Net.hs: removed parserc. Now using list function to parse

Profiling shows that Net.hs and getNumbers specifically takes a huge ammount
of resources. Hope to reduce them with this patch.

darcs-hash:20070711165247-d6583-f56705720e012d5dc3a37d8e86a05145b819feb2.gz

1 files changed, 37 insertions, 22 deletions

diff --git a/Monitors/Net.hs b/Monitors/Net.hs
index d8a3a01..ff1354c 100644
--- a/Monitors/Net.hs
+++ b/Monitors/Net.hs
@@ -15,7 +15,7 @@
 module Monitors.Net where
 
 import Monitors.Common
-import Text.ParserCombinators.Parsec
+import qualified Data.ByteString.Lazy.Char8 as B
 
 data NetDev = NA
             | ND { netDev :: String
@@ -31,10 +31,42 @@ netConfig = mkMConfig
     "<dev>: <rx>|<tx>"      -- template
     ["dev", "rx", "tx"]     -- available replacements
 
-fileNET :: IO String
+
+-- takes to element of a list given their indexes
+getTwoElementsAt :: Int -> Int -> [a] -> [a]
+getTwoElementsAt x y xs =
+    z : [zz]
+      where z = xs !! x
+            zz = xs !! y
+
+-- split a list of strings returning a list with: 1. the first part of
+-- the split; 2. the second part of the split without the Char; 3. the
+-- rest of the list. For instance: 
+--
+-- > splitAtChar ':' ["lo:31174097","31174097"] 
+--
+-- will become ["lo","31174097","31174097"]
+splitAtChar :: Char ->  [String] -> [String]
+splitAtChar c xs =
+    first : (rest xs)
+        where rest = map $ \x -> if (c `elem` x) then (tail $ dropWhile (/= c) x) else x
+              first = head $ map (takeWhile (/= c)) . filter (\x -> (c `elem` x)) $ xs
+
+readNetDev :: [String] -> NetDev               
+readNetDev [] = NA
+readNetDev xs =
+    ND (xs !! 0) (r (xs !! 1)) (r (xs !! 2))
+       where r s | s == "" = 0
+                 | otherwise = (read s) / 1024
+
+fileNET :: IO [NetDev]
 fileNET = 
-    do f <- readFile "/proc/net/dev"
-       return $ unlines $ drop 2 $ lines f
+    do f <- B.readFile "/proc/net/dev"
+       return $ netParser f
+
+netParser :: B.ByteString -> [NetDev]
+netParser =
+    map readNetDev . map (splitAtChar ':') . map (getTwoElementsAt 0 8) . map (words . B.unpack) . drop 2 . B.lines
 
 formatNet :: Float -> Monitor String
 formatNet d =
@@ -49,26 +81,9 @@ printNet nd =
                         parseTemplate [d,rx,tx]
          NA -> return "N/A"
 
-pNetDev :: Parser NetDev
-pNetDev = 
-    do { skipMany1 space
-       ; dn <- manyTill alphaNum $ char ':'
-       ; [rx] <- count 1 getNumbers
-       ; _ <- count 7 getNumbers
-       ; [tx] <- count 1 getNumbers
-       ; _ <- count 7 getNumbers
-       ; char '\n'
-       ; return $ ND dn (rx / 1024) (tx / 1024)
-       } 
-
-parserNet :: Parser [NetDev]
-parserNet = manyTill pNetDev eof
-
 parseNET :: String -> IO [NetDev]
 parseNET nd = 
-    do (a',b') <- doActionTwiceWithDelay interval fileNET
-       a <- runP parserNet a'
-       b <- runP parserNet b'
+    do (a,b) <- doActionTwiceWithDelay interval fileNET
        let netRate f da db = takeDigits 2 $ ((f db) - (f da)) * fromIntegral (1000000 `div` interval)
            diffRate (da,db) = ND (netDev da) 
                               (netRate netRx da db)