module System.Linux.Proc.MemInfo
( MemInfo (..)
, readProcMemInfo
, readProcMemInfoKey
, readProcMemUsage
) where
import Control.Error (ExceptT (..), 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 Data.Maybe (mapMaybe)
import qualified Data.Text as T
import Data.Word (Word64)
import System.Linux.Proc.IO
import System.Linux.Proc.Errors
data MemInfo = MemInfo
{ memTotal :: !Word64
, memFree :: !Word64
, memAvailable :: !Word64
, memBuffers :: !Word64
, memSwapTotal :: !Word64
, memSwapFree :: !Word64
} deriving (Eq, Show)
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
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
readProcMemInfoKey :: ByteString -> IO (Either ProcError Word64)
readProcMemInfoKey target =
runExceptT $ do
xs <- BS.lines <$> readProcFile fpMemInfo
hoistEither . headEither keyError $ mapMaybe findValue xs
where
findValue :: ByteString -> Maybe Word64
findValue bs =
let (key, rest) = BS.break (== ':') bs in
if key /= target
then Nothing
else either (const Nothing) Just $ A.parseOnly pValue rest
keyError :: ProcError
keyError = ProcMemInfoKeyError $ T.pack (BS.unpack target)
fpMemInfo :: FilePath
fpMemInfo = "/proc/meminfo"
fromEither :: a -> Either e a -> a
fromEither a = either (const a) id
headEither :: e -> [a] -> Either e a
headEither e [] = Left e
headEither _ (x:_) = Right x
hoistEither :: Monad m => Either e a -> ExceptT e m a
hoistEither = ExceptT . pure
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
parseFields :: Parser [(ByteString, Word64)]
parseFields =
A.many1 (pFieldValue <* A.endOfLine)
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 ++ "'"