{-# 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

-- | 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
  { MemInfo -> Word64
memTotal :: !Word64 -- ^ Total physical RAM.
  , MemInfo -> Word64
memFree :: !Word64 -- ^ Total free RAM (which includes memory used for filesystem caching).
  , MemInfo -> Word64
memAvailable :: !Word64 -- ^ Available memory.
  , MemInfo -> Word64
memBuffers :: !Word64 -- ^ Amount of RAM used for file buffers.
  , MemInfo -> Word64
memSwapTotal :: !Word64 -- ^ Total amount of swap space.
  , MemInfo -> Word64
memSwapFree :: !Word64 -- ^ Amount of swap space that is free.
  } deriving (MemInfo -> MemInfo -> Bool
(MemInfo -> MemInfo -> Bool)
-> (MemInfo -> MemInfo -> Bool) -> Eq MemInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemInfo -> MemInfo -> Bool
$c/= :: MemInfo -> MemInfo -> Bool
== :: MemInfo -> MemInfo -> Bool
$c== :: MemInfo -> MemInfo -> Bool
Eq, Int -> MemInfo -> ShowS
[MemInfo] -> ShowS
MemInfo -> String
(Int -> MemInfo -> ShowS)
-> (MemInfo -> String) -> ([MemInfo] -> ShowS) -> Show MemInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemInfo] -> ShowS
$cshowList :: [MemInfo] -> ShowS
show :: MemInfo -> String
$cshow :: MemInfo -> String
showsPrec :: Int -> MemInfo -> ShowS
$cshowsPrec :: Int -> MemInfo -> ShowS
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 :: 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 <- String -> ExceptT ProcError IO ByteString
readProcFile String
fpMemInfo
    case Parser [(ByteString, Word64)]
-> ByteString -> Either String [(ByteString, Word64)]
forall a. Parser a -> ByteString -> Either String a
Atto.parseOnly Parser [(ByteString, Word64)]
parseFields ByteString
bs of
      Left String
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
$ String -> Text -> ProcError
ProcParseError String
fpMemInfo (String -> Text
Text.pack String
e)
      Right [(ByteString, Word64)]
xs -> MemInfo -> ExceptT ProcError IO MemInfo
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

-- | 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 :: 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
<$> String -> ExceptT ProcError IO ByteString
readProcFile String
fpMemInfo
    Double -> ExceptT ProcError IO Double
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 (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 String Word64 -> Word64
forall a e. a -> Either e a -> a
fromEither Word64
total (Either String Word64 -> Word64) -> Either String Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Parser Word64 -> ByteString -> Either String Word64
forall a. Parser a -> ByteString -> Either String a
Atto.parseOnly Parser Word64
pValue ByteString
rest)
        (ByteString
"MemAvailable", ByteString
rest) -> (Word64 -> Either String Word64 -> Word64
forall a e. a -> Either e a -> a
fromEither Word64
avail (Either String Word64 -> Word64) -> Either String Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Parser Word64 -> ByteString -> Either String Word64
forall a. Parser a -> ByteString -> Either String 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

-- | Read the value for the given key from `/proc/meminfo`.
-- Although this is in `IO` all exceptions and errors should be caught and
-- returned as a `ProcError`.
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
<$> String -> ExceptT ProcError IO ByteString
readProcFile String
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 (String -> Maybe Word64)
-> (Word64 -> Maybe Word64) -> Either String Word64 -> Maybe Word64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Word64 -> String -> 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 String Word64 -> Maybe Word64)
-> Either String Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Parser Word64 -> ByteString -> Either String Word64
forall a. Parser a -> ByteString -> Either String 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
$ String -> Text
Text.pack (ByteString -> String
BS.unpack ByteString
target)

-- | Render a Word64 as an easy to read size with a bytes, kB, MB, GB TB or PB
-- suffix.
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 = String -> Text
Text.pack (Word64 -> String
forall a. Show a => a -> String
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 = String -> Text
Text.pack (String -> Text) -> (Double -> String) -> 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 -> String) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show

-- -----------------------------------------------------------------------------
-- Internals.

fpMemInfo :: FilePath
fpMemInfo :: String
fpMemInfo = String
"/proc/meminfo"

fromEither :: a -> Either e a -> a
fromEither :: 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 :: 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 :: 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 (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

-- -----------------------------------------------------------------------------
-- Parsers.

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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
Atto.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 :: 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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
Atto.skipSpace Parser ByteString () -> Parser Word64 -> Parser Word64
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 (f :: * -> *) a. Applicative f => a -> f a
pure Word64
val
    ByteString
"kB" -> Word64 -> Parser Word64
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
_ -> String -> Parser Word64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Word64) -> String -> Parser Word64
forall a b. (a -> b) -> a -> b
$ String
"Unexpected '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS.unpack ByteString
rest String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"