packages feed

system-linux-proc (empty) → 0.1.0.0

raw patch · 7 files changed

+243/−0 lines, 7 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, containers, errors, hedgehog, text

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for system-linux-memory++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Erik de Castro Lopo++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Erik de Castro Lopo nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Linux/Proc/File.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Linux.Proc.File+  ( readProcFile+  ) where++import           Control.Error (ExceptT, handleExceptT)++import           Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS++import           Data.Text (Text)+import qualified Data.Text as T++import           System.IO (IOMode (..), withFile)++import           System.Linux.Proc.Errors+++readProcFile :: FilePath -> ExceptT ProcError IO ByteString+readProcFile fpath =+  handleExceptT (ProcReadError fpath . ioErrorToText) $+    -- BS.readFile won't work here because it tries to get the file+    -- length before reading the file and files in the /proc filesystem+    -- are reported as having zero length.+    withFile fpath ReadMode BS.hGetContents++ioErrorToText :: IOError -> Text+ioErrorToText = T.pack . show
+ System/Linux/Proc/MemInfo.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Linux.Proc.MemInfo+  ( MemInfo (..)+  , readProcMemInfo+  , readProcMemUsage+  ) where++import           Control.Error (fromMaybe, runExceptT, throwE)++import           Data.Attoparsec.ByteString.Char8 (Parser)+import qualified Data.Attoparsec.ByteString.Char8 as A+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS++import qualified Data.List as DL+import qualified Data.Map.Strict as DM+import qualified Data.Text as T+import           Data.Word (Word64)++import           System.Linux.Proc.File+import           System.Linux.Proc.Errors++-- | A struct to contain information parsed from the `/proc/meminfo` file+-- (Linux only AFAIK). Fields that are listed as being in kilobytes in the proc+-- filesystem are converted to bytes.+-- Not all versions of the Linux kernel make all the fields in this struct+-- available in which case they will be assigned a value of zero.+data MemInfo = MemInfo+  { memTotal :: !Word64 -- ^ Total physical RAM.+  , memFree :: !Word64 -- ^ Total free RAM (which includes memory used for filesystem caching).+  , memAvailable :: !Word64 -- ^ Available memory.+  , memBuffers :: !Word64 -- ^ Amount of RAM used for file buffers.+  , memSwapTotal :: !Word64 -- ^ Total about of swap space.+  , memSwapFree :: !Word64 -- ^ Amount of swap space that is free.+  } deriving (Eq, Show)++-- | Read the `/proc/meminfo` file (Linux only AFAIK) and return a+-- `MemInfo` structure.+-- Although this is in `IO` all exceptions and errors should be caught and+-- returned as a `ProcError`.+readProcMemInfo :: IO (Either ProcError MemInfo)+readProcMemInfo =+  runExceptT $ do+    bs <- readProcFile fpMemInfo+    case A.parseOnly parseFields bs of+      Left e -> throwE $ ProcParseError fpMemInfo (T.pack e)+      Right xs -> pure $ construct xs++-- | Read `/proc/meminfo` file and return a value calculated from:+--+--      MemAvailable / MemTotal+--+-- Although this is in `IO` all exceptions and errors should be caught and+-- returned as a `ProcError`.+readProcMemUsage :: IO (Either ProcError Double)+readProcMemUsage =+  runExceptT $ do+    xs <- BS.lines <$> readProcFile fpMemInfo+    pure . convert $ DL.foldl' getValues (0, 1) xs+  where+    getValues :: (Word64, Word64) -> ByteString -> (Word64, Word64)+    getValues (avail, total) bs =+      case BS.break (== ':') bs of+        ("MemTotal", rest) -> (avail, fromEither total $ A.parseOnly pValue rest)+        ("MemAvailable", rest) -> (fromEither avail $ A.parseOnly pValue rest, total)+        _ -> (avail, total)++    convert :: (Word64, Word64) -> Double+    convert (avail, total) = fromIntegral avail / fromIntegral total++    fromEither :: a -> Either e a -> a+    fromEither a (Left _) = a+    fromEither _ (Right a) = a++-- -----------------------------------------------------------------------------+-- Internals.++fpMemInfo :: FilePath+fpMemInfo = "/proc/meminfo"++construct :: [(ByteString, Word64)] -> MemInfo+construct xs =+  MemInfo+    (fromMaybe 0 $ DM.lookup "MemTotal" mp)+    (fromMaybe 0 $ DM.lookup "MemFree" mp)+    (fromMaybe 0 $ DM.lookup "MemAvailable" mp)+    (fromMaybe 0 $ DM.lookup "Buffers" mp)+    (fromMaybe 0 $ DM.lookup "SwapTotal" mp)+    (fromMaybe 0 $ DM.lookup "SwapFree" mp)+  where+    mp = DM.fromList xs++-- -----------------------------------------------------------------------------+-- Parsers.++parseFields :: Parser [(ByteString, Word64)]+parseFields =+  A.many1 (pFieldValue <* A.endOfLine)+++{-+The /proc/meminfo file's contents takes the form:++    MemTotal:       16336908 kB+    MemFree:         9605680 kB+    MemAvailable:   12756896 kB+    Buffers:         1315348 kB+    ....++-}++pFieldValue :: Parser (ByteString, Word64)+pFieldValue =+  (,) <$> pName <*> pValue+++pName :: Parser ByteString+pName =+  A.takeWhile (/= ':')++pValue :: Parser Word64+pValue = do+  val <- A.char ':' *> A.skipSpace *> A.decimal+  A.skipSpace+  rest <- A.takeWhile (not . A.isSpace)+  case rest of+    "" -> pure val+    "kB" -> pure $ 1024 * val+    _ -> fail $ "Unexpected '" ++ BS.unpack rest ++ "'"+
+ system-linux-proc.cabal view
@@ -0,0 +1,44 @@+-- Initial system-linux-proc.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                system-linux-proc+version:             0.1.0.0+synopsis:            A library for accessing the /proc filesystem in Linux+-- description:+homepage:            https://github.com/erikd/system-linux-proc+license:             BSD3+license-file:        LICENSE+author:              Erik de Castro Lopo+maintainer:          erikd@mega-nerd.com+copyright:           Copyright (c) 2017 Erik de Castro Lopo+category:            System+build-type:          Simple+extra-source-files:  ChangeLog.md+stability:           provisional+cabal-version:       >=1.10++library+  default-language:   Haskell2010+  ghc-options:        -Wall -fwarn-tabs+  hs-source-dirs:    .++  exposed-modules:     System.Linux.Proc.MemInfo+                     , System.Linux.Proc.File++  build-depends:       base                          >= 4.8         && < 5.0+                     , attoparsec                    == 0.13.*+                     , bytestring                    == 0.10.*+                     , containers                    == 0.5.*+                     , errors                        == 2.2.*+                     , text                          == 1.2.*++test-suite test+  default-language:   Haskell2010+  ghc-options:        -Wall -fwarn-tabs -threaded -O2+  type:               exitcode-stdio-1.0++  main-is:            test-io.hs+  hs-source-dirs:     test++  build-depends:       base                          >= 4.8         && < 5.0+                     , hedgehog
+ test/test-io.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Need more tests."