{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module System.Linux.Proc.MemInfo
( MemInfo (..)
, readProcMemInfo
, readProcMemInfoKey
, readProcMemUsage
, renderSizeBytes
) where
import Control.Error (ExceptT (..), fromMaybe, runExceptT, throwE)
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
#if ! MIN_VERSION_base(4,14,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word64)
import System.Linux.Proc.IO
import System.Linux.Proc.Errors
data MemInfo = MemInfo
{ MemInfo -> Word64
memTotal :: !Word64
, MemInfo -> Word64
memFree :: !Word64
, MemInfo -> Word64
memAvailable :: !Word64
, MemInfo -> Word64
memBuffers :: !Word64
, MemInfo -> Word64
memSwapTotal :: !Word64
, MemInfo -> Word64
memSwapFree :: !Word64
} deriving (MemInfo -> MemInfo -> Bool
(MemInfo -> MemInfo -> Bool)
-> (MemInfo -> MemInfo -> Bool) -> Eq MemInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemInfo -> MemInfo -> Bool
== :: MemInfo -> MemInfo -> Bool
$c/= :: MemInfo -> MemInfo -> Bool
/= :: MemInfo -> MemInfo -> Bool
Eq, Int -> MemInfo -> ShowS
[MemInfo] -> ShowS
MemInfo -> [Char]
(Int -> MemInfo -> ShowS)
-> (MemInfo -> [Char]) -> ([MemInfo] -> ShowS) -> Show MemInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemInfo -> ShowS
showsPrec :: Int -> MemInfo -> ShowS
$cshow :: MemInfo -> [Char]
show :: MemInfo -> [Char]
$cshowList :: [MemInfo] -> ShowS
showList :: [MemInfo] -> ShowS
Show)
readProcMemInfo :: IO (Either ProcError MemInfo)
readProcMemInfo :: IO (Either ProcError MemInfo)
readProcMemInfo =
ExceptT ProcError IO MemInfo -> IO (Either ProcError MemInfo)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ProcError IO MemInfo -> IO (Either ProcError MemInfo))
-> ExceptT ProcError IO MemInfo -> IO (Either ProcError MemInfo)
forall a b. (a -> b) -> a -> b
$ do
ByteString
bs <- [Char] -> ExceptT ProcError IO ByteString
readProcFile [Char]
fpMemInfo
case Parser [(ByteString, Word64)]
-> ByteString -> Either [Char] [(ByteString, Word64)]
forall a. Parser a -> ByteString -> Either [Char] a
Atto.parseOnly Parser [(ByteString, Word64)]
parseFields ByteString
bs of
Left [Char]
e -> ProcError -> ExceptT ProcError IO MemInfo
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ProcError -> ExceptT ProcError IO MemInfo)
-> ProcError -> ExceptT ProcError IO MemInfo
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> ProcError
ProcParseError [Char]
fpMemInfo ([Char] -> Text
Text.pack [Char]
e)
Right [(ByteString, Word64)]
xs -> MemInfo -> ExceptT ProcError IO MemInfo
forall a. a -> ExceptT ProcError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemInfo -> ExceptT ProcError IO MemInfo)
-> MemInfo -> ExceptT ProcError IO MemInfo
forall a b. (a -> b) -> a -> b
$ [(ByteString, Word64)] -> MemInfo
construct [(ByteString, Word64)]
xs
readProcMemUsage :: IO (Either ProcError Double)
readProcMemUsage :: IO (Either ProcError Double)
readProcMemUsage =
ExceptT ProcError IO Double -> IO (Either ProcError Double)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ProcError IO Double -> IO (Either ProcError Double))
-> ExceptT ProcError IO Double -> IO (Either ProcError Double)
forall a b. (a -> b) -> a -> b
$ do
[ByteString]
xs <- ByteString -> [ByteString]
BS.lines (ByteString -> [ByteString])
-> ExceptT ProcError IO ByteString
-> ExceptT ProcError IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ExceptT ProcError IO ByteString
readProcFile [Char]
fpMemInfo
Double -> ExceptT ProcError IO Double
forall a. a -> ExceptT ProcError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> ExceptT ProcError IO Double)
-> ((Word64, Word64) -> Double)
-> (Word64, Word64)
-> ExceptT ProcError IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, Word64) -> Double
convert ((Word64, Word64) -> ExceptT ProcError IO Double)
-> (Word64, Word64) -> ExceptT ProcError IO Double
forall a b. (a -> b) -> a -> b
$ ((Word64, Word64) -> ByteString -> (Word64, Word64))
-> (Word64, Word64) -> [ByteString] -> (Word64, Word64)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Word64, Word64) -> ByteString -> (Word64, Word64)
getValues (Word64
0, Word64
1) [ByteString]
xs
where
getValues :: (Word64, Word64) -> ByteString -> (Word64, Word64)
getValues :: (Word64, Word64) -> ByteString -> (Word64, Word64)
getValues (Word64
avail, Word64
total) ByteString
bs =
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') ByteString
bs of
(ByteString
"MemTotal", ByteString
rest) -> (Word64
avail, Word64 -> Either [Char] Word64 -> Word64
forall a e. a -> Either e a -> a
fromEither Word64
total (Either [Char] Word64 -> Word64) -> Either [Char] Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Parser Word64 -> ByteString -> Either [Char] Word64
forall a. Parser a -> ByteString -> Either [Char] a
Atto.parseOnly Parser Word64
pValue ByteString
rest)
(ByteString
"MemAvailable", ByteString
rest) -> (Word64 -> Either [Char] Word64 -> Word64
forall a e. a -> Either e a -> a
fromEither Word64
avail (Either [Char] Word64 -> Word64) -> Either [Char] Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Parser Word64 -> ByteString -> Either [Char] Word64
forall a. Parser a -> ByteString -> Either [Char] a
Atto.parseOnly Parser Word64
pValue ByteString
rest, Word64
total)
(ByteString, ByteString)
_ -> (Word64
avail, Word64
total)
convert :: (Word64, Word64) -> Double
convert :: (Word64, Word64) -> Double
convert (Word64
avail, Word64
total) = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
avail Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
total
readProcMemInfoKey :: ByteString -> IO (Either ProcError Word64)
readProcMemInfoKey :: ByteString -> IO (Either ProcError Word64)
readProcMemInfoKey ByteString
target =
ExceptT ProcError IO Word64 -> IO (Either ProcError Word64)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ProcError IO Word64 -> IO (Either ProcError Word64))
-> ExceptT ProcError IO Word64 -> IO (Either ProcError Word64)
forall a b. (a -> b) -> a -> b
$ do
[ByteString]
xs <- ByteString -> [ByteString]
BS.lines (ByteString -> [ByteString])
-> ExceptT ProcError IO ByteString
-> ExceptT ProcError IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ExceptT ProcError IO ByteString
readProcFile [Char]
fpMemInfo
Either ProcError Word64 -> ExceptT ProcError IO Word64
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither (Either ProcError Word64 -> ExceptT ProcError IO Word64)
-> ([Word64] -> Either ProcError Word64)
-> [Word64]
-> ExceptT ProcError IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcError -> [Word64] -> Either ProcError Word64
forall e a. e -> [a] -> Either e a
headEither ProcError
keyError ([Word64] -> ExceptT ProcError IO Word64)
-> [Word64] -> ExceptT ProcError IO Word64
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe Word64) -> [ByteString] -> [Word64]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ByteString -> Maybe Word64
findValue [ByteString]
xs
where
findValue :: ByteString -> Maybe Word64
findValue :: ByteString -> Maybe Word64
findValue ByteString
bs =
let (ByteString
key, ByteString
rest) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') ByteString
bs in
if ByteString
key ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
target
then Maybe Word64
forall a. Maybe a
Nothing
else ([Char] -> Maybe Word64)
-> (Word64 -> Maybe Word64) -> Either [Char] Word64 -> Maybe Word64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Word64 -> [Char] -> Maybe Word64
forall a b. a -> b -> a
const Maybe Word64
forall a. Maybe a
Nothing) Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Either [Char] Word64 -> Maybe Word64)
-> Either [Char] Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Parser Word64 -> ByteString -> Either [Char] Word64
forall a. Parser a -> ByteString -> Either [Char] a
Atto.parseOnly Parser Word64
pValue ByteString
rest
keyError :: ProcError
keyError :: ProcError
keyError = Text -> ProcError
ProcMemInfoKeyError (Text -> ProcError) -> Text -> ProcError
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack (ByteString -> [Char]
BS.unpack ByteString
target)
renderSizeBytes :: Word64 -> Text
renderSizeBytes :: Word64 -> Text
renderSizeBytes Word64
s
| Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e15 = Double -> Text
render (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e15) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" PB"
| Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e12 = Double -> Text
render (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e12) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" TB"
| Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e12 = Double -> Text
render (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e12) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" TB"
| Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e9 = Double -> Text
render (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e-9) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" GB"
| Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e6 = Double -> Text
render (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e-6) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" MB"
| Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e3 = Double -> Text
render (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e-3) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" kB"
| Bool
otherwise = [Char] -> Text
Text.pack (Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes"
where
d :: Double
d = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s :: Double
render :: Double -> Text
render = [Char] -> Text
Text.pack ([Char] -> Text) -> (Double -> [Char]) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
List.take Int
5 ShowS -> (Double -> [Char]) -> Double -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
forall a. Show a => a -> [Char]
show
fpMemInfo :: FilePath
fpMemInfo :: [Char]
fpMemInfo = [Char]
"/proc/meminfo"
fromEither :: a -> Either e a -> a
fromEither :: forall a e. a -> Either e a -> a
fromEither a
a = (e -> a) -> (a -> a) -> Either e a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (a -> e -> a
forall a b. a -> b -> a
const a
a) a -> a
forall a. a -> a
id
headEither :: e -> [a] -> Either e a
headEither :: forall e a. e -> [a] -> Either e a
headEither e
e [] = e -> Either e a
forall a b. a -> Either a b
Left e
e
headEither e
_ (a
x:[a]
_) = a -> Either e a
forall a b. b -> Either a b
Right a
x
hoistEither :: Monad m => Either e a -> ExceptT e m a
hoistEither :: forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> (Either e a -> m (Either e a)) -> Either e a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
construct :: [(ByteString, Word64)] -> MemInfo
construct :: [(ByteString, Word64)] -> MemInfo
construct [(ByteString, Word64)]
xs =
Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> MemInfo
MemInfo
(Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Map ByteString Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"MemTotal" Map ByteString Word64
mp)
(Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Map ByteString Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"MemFree" Map ByteString Word64
mp)
(Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Map ByteString Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"MemAvailable" Map ByteString Word64
mp)
(Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Map ByteString Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"Buffers" Map ByteString Word64
mp)
(Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Map ByteString Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"SwapTotal" Map ByteString Word64
mp)
(Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Map ByteString Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"SwapFree" Map ByteString Word64
mp)
where
mp :: Map ByteString Word64
mp = [(ByteString, Word64)] -> Map ByteString Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ByteString, Word64)]
xs
parseFields :: Parser [(ByteString, Word64)]
parseFields :: Parser [(ByteString, Word64)]
parseFields =
Parser ByteString (ByteString, Word64)
-> Parser [(ByteString, Word64)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Atto.many1 (Parser ByteString (ByteString, Word64)
pFieldValue Parser ByteString (ByteString, Word64)
-> Parser ByteString () -> Parser ByteString (ByteString, Word64)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
Atto.endOfLine)
pFieldValue :: Parser (ByteString, Word64)
pFieldValue :: Parser ByteString (ByteString, Word64)
pFieldValue =
(,) (ByteString -> Word64 -> (ByteString, Word64))
-> Parser ByteString ByteString
-> Parser ByteString (Word64 -> (ByteString, Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
pName Parser ByteString (Word64 -> (ByteString, Word64))
-> Parser Word64 -> Parser ByteString (ByteString, Word64)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word64
pValue
pName :: Parser ByteString
pName :: Parser ByteString ByteString
pName =
(Char -> Bool) -> Parser ByteString ByteString
Atto.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')
pValue :: Parser Word64
pValue :: Parser Word64
pValue = do
Word64
val <- Char -> Parser Char
Atto.char Char
':' Parser Char -> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
Atto.skipSpace Parser ByteString () -> Parser Word64 -> Parser Word64
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word64
forall a. Integral a => Parser a
Atto.decimal
Parser ByteString ()
Atto.skipSpace
ByteString
rest <- (Char -> Bool) -> Parser ByteString ByteString
Atto.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Atto.isSpace)
case ByteString
rest of
ByteString
"" -> Word64 -> Parser Word64
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
val
ByteString
"kB" -> Word64 -> Parser Word64
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Parser Word64) -> Word64 -> Parser Word64
forall a b. (a -> b) -> a -> b
$ Word64
1024 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
val
ByteString
_ -> [Char] -> Parser Word64
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Word64) -> [Char] -> Parser Word64
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BS.unpack ByteString
rest [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"'"