{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : System.MemInfo.Proc
Copyright   : (c) 2022 Tim Emiola
Maintainer  : Tim Emiola <adetokunbo@emio.la>
SPDX-License-Identifier: BSD3

This module provides types that model data from files in the @Linux proc
filesystem@ that track memory usage, combinators for parsing the files contents,
and for grouping the results.
-}
module System.MemInfo.Proc (
  -- * Combine process memory metrics
  MemUsage (..),
  amass,

  -- * Parse process memory metrics
  ProcUsage (..),
  parseFromSmap,
  parseFromStatm,

  -- * Parse \/proc\/\<pid\>\/exe
  ExeInfo (..),
  parseExeInfo,

  -- * Parse \/proc\/<pid\>\/status
  parseStatusInfo,
  StatusInfo (..),
  BadStatus (..),
) where

import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Validity (Validity (..), check, delve)
import Data.Validity.Text ()
import GHC.Generics (Generic)
import System.MemInfo.Prelude
import System.MemInfo.SysInfo (KernelVersion, fickleSharing)


-- | Represents the information about a process obtained from /proc/<pid>/status
data StatusInfo = StatusInfo
  { StatusInfo -> Text
siName :: !Text
  , StatusInfo -> ProcessID
siParent :: !ProcessID
  }
  deriving (StatusInfo -> StatusInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusInfo -> StatusInfo -> Bool
$c/= :: StatusInfo -> StatusInfo -> Bool
== :: StatusInfo -> StatusInfo -> Bool
$c== :: StatusInfo -> StatusInfo -> Bool
Eq, Int -> StatusInfo -> ShowS
[StatusInfo] -> ShowS
StatusInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusInfo] -> ShowS
$cshowList :: [StatusInfo] -> ShowS
show :: StatusInfo -> String
$cshow :: StatusInfo -> String
showsPrec :: Int -> StatusInfo -> ShowS
$cshowsPrec :: Int -> StatusInfo -> ShowS
Show, forall x. Rep StatusInfo x -> StatusInfo
forall x. StatusInfo -> Rep StatusInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StatusInfo x -> StatusInfo
$cfrom :: forall x. StatusInfo -> Rep StatusInfo x
Generic)


instance Validity StatusInfo where
  validate :: StatusInfo -> Validation
validate StatusInfo {Text
siName :: Text
siName :: StatusInfo -> Text
siName, ProcessID
siParent :: ProcessID
siParent :: StatusInfo -> ProcessID
siParent} =
    let name' :: Text
name' = Text -> Text
Text.strip Text
siName
        nameOk :: Bool
nameOk = Text -> Int
Text.length Text
name' forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Text
siName forall a. Eq a => a -> a -> Bool
== Text
name'
     in forall a. Monoid a => [a] -> a
mconcat
          [ Bool -> String -> Validation
check Bool
nameOk String
"the process name"
          , forall a. Validity a => String -> a -> Validation
delve String
"the process ID" forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger ProcessID
siParent
          ]


-- | Indicates why @'parseStatusInfo'@ failed
data BadStatus
  = NoCmd
  | NoParent
  deriving (BadStatus -> BadStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BadStatus -> BadStatus -> Bool
$c/= :: BadStatus -> BadStatus -> Bool
== :: BadStatus -> BadStatus -> Bool
$c== :: BadStatus -> BadStatus -> Bool
Eq, Int -> BadStatus -> ShowS
[BadStatus] -> ShowS
BadStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BadStatus] -> ShowS
$cshowList :: [BadStatus] -> ShowS
show :: BadStatus -> String
$cshow :: BadStatus -> String
showsPrec :: Int -> BadStatus -> ShowS
$cshowsPrec :: Int -> BadStatus -> ShowS
Show)


-- | Parses the content of \/proc\/\<pid\>\/status into a @'StatusInfo'@
parseStatusInfo :: Text -> Either BadStatus StatusInfo
parseStatusInfo :: Text -> Either BadStatus StatusInfo
parseStatusInfo Text
content =
  let
    statusLines :: [Text]
statusLines = Text -> [Text]
Text.lines Text
content
    parseLine :: Text -> Text -> Maybe Text
parseLine Text
key Text
l = Text -> Text
Text.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
Text.stripPrefix (Text
key forall a. Semigroup a => a -> a -> a
<> Text
":") Text
l
    mkStep :: Text -> Maybe Text -> Text -> Maybe Text
mkStep Text
prefix Maybe Text
acc Text
l = case Maybe Text
acc of
      Maybe Text
Nothing -> Text -> Text -> Maybe Text
parseLine Text
prefix Text
l
      Maybe Text
found -> Maybe Text
found
    name :: Either BadStatus Text
name = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left BadStatus
NoCmd) forall a b. b -> Either a b
Right Maybe Text
name'
    name' :: Maybe Text
name' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Text -> Maybe Text -> Text -> Maybe Text
mkStep Text
"Name") forall a. Maybe a
Nothing [Text]
statusLines
    ppidTxt :: Maybe Text
ppidTxt = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Text -> Maybe Text -> Text -> Maybe Text
mkStep Text
"PPid") forall a. Maybe a
Nothing [Text]
statusLines
    parsePpid :: Text -> Maybe ProcessID
parsePpid = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
    ppId :: Either BadStatus ProcessID
ppId = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left BadStatus
NoParent) forall a b. b -> Either a b
Right (Maybe Text
ppidTxt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe ProcessID
parsePpid)
   in
    Text -> ProcessID -> StatusInfo
StatusInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either BadStatus Text
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either BadStatus ProcessID
ppId


-- | Parses the target of \/proc\/\<pid\>\/exe into a @'ExeInfo'@
parseExeInfo :: Text -> ExeInfo
parseExeInfo :: Text -> ExeInfo
parseExeInfo Text
x =
  let eiTarget :: Text
eiTarget = Text -> Text
takeTillNull Text
x
      eiDeleted :: Bool
eiDeleted = Text
delEnd Text -> Text -> Bool
`Text.isSuffixOf` Text
eiTarget
      withoutDeleted :: Text
withoutDeleted = Text -> Text -> Text -> Text
Text.replace Text
delEnd Text
"" Text
eiTarget
      eiOriginal :: Text
eiOriginal = if Bool
eiDeleted then Text
withoutDeleted else Text
eiTarget
      takeTillNull :: Text -> Text
takeTillNull = (Char -> Bool) -> Text -> Text
Text.takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNull)
   in ExeInfo {Bool
eiDeleted :: Bool
eiDeleted :: Bool
eiDeleted, Text
eiOriginal :: Text
eiOriginal :: Text
eiOriginal, Text
eiTarget :: Text
eiTarget :: Text
eiTarget}


delEnd :: Text
delEnd :: Text
delEnd = Text
" (deleted)"


-- | Represents the information about a process obtained from \/proc\/\<pid\>\/exe
data ExeInfo = ExeInfo
  { ExeInfo -> Text
eiTarget :: !Text
  -- ^ the path that the link \/proc\/\<pid\>\/exe resolves to
  , ExeInfo -> Text
eiOriginal :: !Text
  -- ^ a sanitized form of eiTarget; it removes the / (deleted)/ suffix
  , ExeInfo -> Bool
eiDeleted :: !Bool
  -- ^ does eiTarget end with /(deleted)/?
  }
  deriving (ExeInfo -> ExeInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExeInfo -> ExeInfo -> Bool
$c/= :: ExeInfo -> ExeInfo -> Bool
== :: ExeInfo -> ExeInfo -> Bool
$c== :: ExeInfo -> ExeInfo -> Bool
Eq, Int -> ExeInfo -> ShowS
[ExeInfo] -> ShowS
ExeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExeInfo] -> ShowS
$cshowList :: [ExeInfo] -> ShowS
show :: ExeInfo -> String
$cshow :: ExeInfo -> String
showsPrec :: Int -> ExeInfo -> ShowS
$cshowsPrec :: Int -> ExeInfo -> ShowS
Show, forall x. Rep ExeInfo x -> ExeInfo
forall x. ExeInfo -> Rep ExeInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExeInfo x -> ExeInfo
$cfrom :: forall x. ExeInfo -> Rep ExeInfo x
Generic)


instance Validity ExeInfo where
  validate :: ExeInfo -> Validation
validate ExeInfo
ei | ExeInfo -> Bool
eiDeleted ExeInfo
ei = Bool -> String -> Validation
check (ExeInfo -> Text
eiOriginal ExeInfo
ei forall a. Semigroup a => a -> a -> a
<> Text
delEnd forall a. Eq a => a -> a -> Bool
== ExeInfo -> Text
eiTarget ExeInfo
ei) String
"target is actually deleted"
  validate ExeInfo
ei = Bool -> String -> Validation
check (ExeInfo -> Text
eiOriginal ExeInfo
ei forall a. Eq a => a -> a -> Bool
== ExeInfo -> Text
eiTarget ExeInfo
ei) String
"target is not deleted"


-- | Combine @'ProcUsage'@, grouping them by the effective program name
amass ::
  Ord a =>
  Bool ->
  [(a, ProcUsage)] ->
  Map a MemUsage
amass :: forall a. Ord a => Bool -> [(a, ProcUsage)] -> Map a MemUsage
amass Bool
hasPss = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Bool -> SubTotal -> MemUsage
fromSubTotal Bool
hasPss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a.
Ord a =>
Bool -> Map a SubTotal -> (a, ProcUsage) -> Map a SubTotal
incrSubTotals Bool
hasPss) forall a. Monoid a => a
mempty


fromSubTotal :: Bool -> SubTotal -> MemUsage
fromSubTotal :: Bool -> SubTotal -> MemUsage
fromSubTotal Bool
hasPss SubTotal
st =
  let reducedPrivate :: Int
reducedPrivate = SubTotal -> Int
stPrivate SubTotal
st forall a. Integral a => a -> a -> a
`div` SubTotal -> Int
stCount SubTotal
st
      areThreads :: Bool
areThreads = SubTotal -> Bool
threadsNotProcs SubTotal
st
      reducedShared :: Int
reducedShared = SubTotal -> Int
stShared SubTotal
st forall a. Integral a => a -> a -> a
`div` SubTotal -> Int
stCount SubTotal
st
      newPrivate :: Int
newPrivate = if Bool
areThreads then Int
reducedPrivate else SubTotal -> Int
stPrivate SubTotal
st
      newShared :: Int
newShared = if Bool
areThreads Bool -> Bool -> Bool
&& Bool
hasPss then Int
reducedShared else SubTotal -> Int
stShared SubTotal
st
   in MemUsage
        { muShared :: Int
muShared = Int
newShared forall a. Num a => a -> a -> a
+ SubTotal -> Int
stSharedHuge SubTotal
st
        , muPrivate :: Int
muPrivate = Int
newPrivate forall a. Num a => a -> a -> a
+ Int
newShared forall a. Num a => a -> a -> a
+ SubTotal -> Int
stSharedHuge SubTotal
st
        , muSwap :: Int
muSwap = SubTotal -> Int
stSwap SubTotal
st
        , muCount :: Int
muCount = SubTotal -> Int
stCount SubTotal
st
        }


-- | Represents the measured memory usage of a program
data MemUsage = MemUsage
  { MemUsage -> Int
muShared :: !Int
  -- ^ the total shared memory in use
  , MemUsage -> Int
muPrivate :: !Int
  -- ^ the total private memory in use
  , MemUsage -> Int
muCount :: !Int
  -- ^ the number of processes running as the program
  , MemUsage -> Int
muSwap :: !Int
  -- ^ the total swap memory in use
  }
  deriving (MemUsage -> MemUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemUsage -> MemUsage -> Bool
$c/= :: MemUsage -> MemUsage -> Bool
== :: MemUsage -> MemUsage -> Bool
$c== :: MemUsage -> MemUsage -> Bool
Eq, Int -> MemUsage -> ShowS
[MemUsage] -> ShowS
MemUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemUsage] -> ShowS
$cshowList :: [MemUsage] -> ShowS
show :: MemUsage -> String
$cshow :: MemUsage -> String
showsPrec :: Int -> MemUsage -> ShowS
$cshowsPrec :: Int -> MemUsage -> ShowS
Show)


incrSubTotals ::
  Ord a =>
  Bool ->
  Map a SubTotal ->
  (a, ProcUsage) ->
  Map a SubTotal
incrSubTotals :: forall a.
Ord a =>
Bool -> Map a SubTotal -> (a, ProcUsage) -> Map a SubTotal
incrSubTotals Bool
hasPss Map a SubTotal
acc (a
cmd, ProcUsage
mem) =
  let combinePrivate :: a -> a -> a
combinePrivate a
next a
prev | Bool
hasPss = a
next forall a. Num a => a -> a -> a
+ a
prev
      combinePrivate a
next a
prev = forall a. Ord a => a -> a -> a
max a
next a
prev
      nextSt :: SubTotal
nextSt =
        SubTotal
          { stShared :: Int
stShared = ProcUsage -> Int
puShared ProcUsage
mem
          , stSharedHuge :: Int
stSharedHuge = ProcUsage -> Int
puSharedHuge ProcUsage
mem
          , stCount :: Int
stCount = Int
1
          , stPrivate :: Int
stPrivate = ProcUsage -> Int
puPrivate ProcUsage
mem
          , stSwap :: Int
stSwap = ProcUsage -> Int
puSwap ProcUsage
mem
          , stMemIds :: Set Int
stMemIds = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ ProcUsage -> Int
puMemId ProcUsage
mem
          }
      update' :: SubTotal -> SubTotal -> SubTotal
update' SubTotal
next SubTotal
prev =
        SubTotal
prev
          { stShared :: Int
stShared = SubTotal -> Int
stShared SubTotal
next forall a. Num a => a -> a -> a
+ SubTotal -> Int
stShared SubTotal
prev
          , stSharedHuge :: Int
stSharedHuge = forall a. Ord a => a -> a -> a
max (SubTotal -> Int
stSharedHuge SubTotal
next) (SubTotal -> Int
stSharedHuge SubTotal
prev)
          , stPrivate :: Int
stPrivate = forall {a}. (Num a, Ord a) => a -> a -> a
combinePrivate (SubTotal -> Int
stPrivate SubTotal
next) (SubTotal -> Int
stPrivate SubTotal
prev)
          , stCount :: Int
stCount = SubTotal -> Int
stCount SubTotal
next forall a. Num a => a -> a -> a
+ SubTotal -> Int
stCount SubTotal
prev
          , stSwap :: Int
stSwap = SubTotal -> Int
stSwap SubTotal
next forall a. Num a => a -> a -> a
+ SubTotal -> Int
stSwap SubTotal
prev
          , stMemIds :: Set Int
stMemIds = forall a. Ord a => Set a -> Set a -> Set a
Set.union (SubTotal -> Set Int
stMemIds SubTotal
next) (SubTotal -> Set Int
stMemIds SubTotal
prev)
          }
   in forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith SubTotal -> SubTotal -> SubTotal
update' a
cmd SubTotal
nextSt Map a SubTotal
acc


data SubTotal = SubTotal
  { SubTotal -> Int
stShared :: !Int
  , SubTotal -> Int
stSharedHuge :: !Int
  , SubTotal -> Int
stPrivate :: !Int
  , SubTotal -> Int
stCount :: !Int
  , SubTotal -> Int
stSwap :: !Int
  , SubTotal -> Set Int
stMemIds :: !(Set Int)
  }
  deriving (SubTotal -> SubTotal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubTotal -> SubTotal -> Bool
$c/= :: SubTotal -> SubTotal -> Bool
== :: SubTotal -> SubTotal -> Bool
$c== :: SubTotal -> SubTotal -> Bool
Eq, Int -> SubTotal -> ShowS
[SubTotal] -> ShowS
SubTotal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubTotal] -> ShowS
$cshowList :: [SubTotal] -> ShowS
show :: SubTotal -> String
$cshow :: SubTotal -> String
showsPrec :: Int -> SubTotal -> ShowS
$cshowsPrec :: Int -> SubTotal -> ShowS
Show)


-- If a process is invoked with clone using flags CLONE_VM and not CLONE_THREAD
-- it will share the same memory space as it's parent; this needs to accounted
-- for
--
-- This is detected by computing the memId has the hash of lines for the proc
-- read from its smaps file.
threadsNotProcs :: SubTotal -> Bool
threadsNotProcs :: SubTotal -> Bool
threadsNotProcs SubTotal
cs = forall a. Set a -> Int
Set.size (SubTotal -> Set Int
stMemIds SubTotal
cs) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& SubTotal -> Int
stCount SubTotal
cs forall a. Ord a => a -> a -> Bool
> Int
1


-- | Represents the memory metrics for a single process
data ProcUsage = ProcUsage
  { ProcUsage -> Int
puPrivate :: !Int
  , ProcUsage -> Int
puShared :: !Int
  , ProcUsage -> Int
puSharedHuge :: !Int
  , ProcUsage -> Int
puSwap :: !Int
  , ProcUsage -> Int
puMemId :: !Int
  }
  deriving (ProcUsage -> ProcUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcUsage -> ProcUsage -> Bool
$c/= :: ProcUsage -> ProcUsage -> Bool
== :: ProcUsage -> ProcUsage -> Bool
$c== :: ProcUsage -> ProcUsage -> Bool
Eq, Int -> ProcUsage -> ShowS
[ProcUsage] -> ShowS
ProcUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcUsage] -> ShowS
$cshowList :: [ProcUsage] -> ShowS
show :: ProcUsage -> String
$cshow :: ProcUsage -> String
showsPrec :: Int -> ProcUsage -> ShowS
$cshowsPrec :: Int -> ProcUsage -> ShowS
Show)


-- value used as page size when @MemStat@ is calcuated from statm
pageSizeKiB :: Int
pageSizeKiB :: Int
pageSizeKiB = Int
4


-- | Parse @'ProcUsage'@ from the contents of \/proc\/\<pid\>\/statm
parseFromStatm :: KernelVersion -> Text -> Maybe ProcUsage
parseFromStatm :: KernelVersion -> Text -> Maybe ProcUsage
parseFromStatm KernelVersion
version Text
content =
  let
    parseWord :: Text -> Maybe [a] -> Maybe [a]
parseWord Text
w (Just [a]
acc) = (\a
x -> forall a. a -> Maybe a
Just (a
x forall a. a -> [a] -> [a]
: [a]
acc)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
w)
    parseWord Text
_ Maybe [a]
Nothing = forall a. Maybe a
Nothing
    parseMetrics :: [Text] -> Maybe [Int]
parseMetrics = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Read a => Text -> Maybe [a] -> Maybe [a]
parseWord (forall a. a -> Maybe a
Just forall a. Monoid a => a
mempty)
    withMemId :: ProcUsage
withMemId = ProcUsage
ppZero {puMemId :: Int
puMemId = forall a. Hashable a => a -> Int
hash Text
content}
    fromRss :: Int -> Int -> ProcUsage
fromRss Int
rss Int
_shared
      | KernelVersion -> Bool
fickleSharing KernelVersion
version = ProcUsage
withMemId {puPrivate :: Int
puPrivate = Int
rss forall a. Num a => a -> a -> a
* Int
pageSizeKiB}
    fromRss Int
rss Int
shared =
      ProcUsage
withMemId
        { puShared :: Int
puShared = Int
shared forall a. Num a => a -> a -> a
* Int
pageSizeKiB
        , puPrivate :: Int
puPrivate = (Int
rss forall a. Num a => a -> a -> a
- Int
shared) forall a. Num a => a -> a -> a
* Int
pageSizeKiB
        }
    fromRss' :: [Int] -> Maybe ProcUsage
fromRss' (Int
_size : Int
rss : Int
shared : [Int]
_xs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Int -> ProcUsage
fromRss Int
rss Int
shared
    fromRss' [Int]
_ = forall a. Maybe a
Nothing
   in
    [Text] -> Maybe [Int]
parseMetrics (Text -> [Text]
Text.words Text
content) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> Maybe ProcUsage
fromRss'


ppZero :: ProcUsage
ppZero :: ProcUsage
ppZero =
  ProcUsage
    { puPrivate :: Int
puPrivate = Int
0
    , puShared :: Int
puShared = Int
0
    , puSharedHuge :: Int
puSharedHuge = Int
0
    , puSwap :: Int
puSwap = Int
0
    , puMemId :: Int
puMemId = Int
0
    }


-- | Parse @'ProcUsage'@ from the contents of \/proc\/\<pid\>\/smap
parseFromSmap :: Text -> ProcUsage
parseFromSmap :: Text -> ProcUsage
parseFromSmap = SmapStats -> ProcUsage
fromSmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SmapStats
parseSmapStats


parseSmapStats :: Text -> SmapStats
parseSmapStats :: Text -> SmapStats
parseSmapStats Text
content =
  let noMemId :: SmapStats
noMemId = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SmapStats -> Text -> SmapStats
incrSmapStats SmapStats
ssZero forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
content
   in SmapStats
noMemId {ssMemId :: Int
ssMemId = forall a. Hashable a => a -> Int
hash Text
content}


fromSmap :: SmapStats -> ProcUsage
fromSmap :: SmapStats -> ProcUsage
fromSmap SmapStats
ss =
  let pssTweak :: Int
pssTweak = SmapStats -> Int
ssPssCount SmapStats
ss forall a. Integral a => a -> a -> a
`div` Int
2 -- add ~0.5 per line to counter truncation
      pssShared :: Int
pssShared = SmapStats -> Int
ssPss SmapStats
ss forall a. Num a => a -> a -> a
+ Int
pssTweak forall a. Num a => a -> a -> a
- SmapStats -> Int
ssPrivate SmapStats
ss
   in ProcUsage
        { puSwap :: Int
puSwap = if SmapStats -> Bool
ssHasSwapPss SmapStats
ss then SmapStats -> Int
ssSwapPss SmapStats
ss else SmapStats -> Int
ssSwap SmapStats
ss
        , puShared :: Int
puShared = if SmapStats -> Bool
ssHasPss SmapStats
ss then Int
pssShared else SmapStats -> Int
ssShared SmapStats
ss
        , puSharedHuge :: Int
puSharedHuge = SmapStats -> Int
ssSharedHuge SmapStats
ss
        , puPrivate :: Int
puPrivate = SmapStats -> Int
ssPrivate SmapStats
ss forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssPrivateHuge SmapStats
ss
        , puMemId :: Int
puMemId = SmapStats -> Int
ssMemId SmapStats
ss
        }


-- | Represents per-process data read from \/proc\/\<pid\>\/smap
data SmapStats = SmapStats
  { SmapStats -> Int
ssPss :: !Int
  , SmapStats -> Int
ssPssCount :: !Int
  , SmapStats -> Int
ssSwap :: !Int
  , SmapStats -> Int
ssSwapPss :: !Int
  , SmapStats -> Int
ssPrivate :: !Int
  , SmapStats -> Int
ssPrivateHuge :: !Int
  , SmapStats -> Int
ssSharedHuge :: !Int
  , SmapStats -> Int
ssShared :: !Int
  , SmapStats -> Int
ssMemId :: !Int
  , SmapStats -> Bool
ssHasPss :: !Bool
  , SmapStats -> Bool
ssHasSwapPss :: !Bool
  }
  deriving (SmapStats -> SmapStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmapStats -> SmapStats -> Bool
$c/= :: SmapStats -> SmapStats -> Bool
== :: SmapStats -> SmapStats -> Bool
$c== :: SmapStats -> SmapStats -> Bool
Eq, Int -> SmapStats -> ShowS
[SmapStats] -> ShowS
SmapStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmapStats] -> ShowS
$cshowList :: [SmapStats] -> ShowS
show :: SmapStats -> String
$cshow :: SmapStats -> String
showsPrec :: Int -> SmapStats -> ShowS
$cshowsPrec :: Int -> SmapStats -> ShowS
Show)


ssZero :: SmapStats
ssZero :: SmapStats
ssZero =
  SmapStats
    { ssPss :: Int
ssPss = Int
0
    , ssPssCount :: Int
ssPssCount = Int
0
    , ssSwap :: Int
ssSwap = Int
0
    , ssSwapPss :: Int
ssSwapPss = Int
0
    , ssPrivate :: Int
ssPrivate = Int
0
    , ssPrivateHuge :: Int
ssPrivateHuge = Int
0
    , ssSharedHuge :: Int
ssSharedHuge = Int
0
    , ssShared :: Int
ssShared = Int
0
    , ssHasSwapPss :: Bool
ssHasSwapPss = Bool
False
    , ssHasPss :: Bool
ssHasPss = Bool
False
    , ssMemId :: Int
ssMemId = Int
0
    }


-- Q: is it worth the dependency to replace this with lens from a lens package ?
incrPss
  , incrSwap
  , incrSwapPss
  , incrPrivate
  , incrPrivateHuge
  , incrShared
  , incrSharedHuge ::
    SmapStats -> Maybe Int -> SmapStats
incrPss :: SmapStats -> Maybe Int -> SmapStats
incrPss SmapStats
ms = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SmapStats
ms forall a b. (a -> b) -> a -> b
$ \Int
n -> SmapStats
ms {ssPss :: Int
ssPss = Int
n forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssPss SmapStats
ms}
incrSwap :: SmapStats -> Maybe Int -> SmapStats
incrSwap SmapStats
ms = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SmapStats
ms forall a b. (a -> b) -> a -> b
$ \Int
n -> SmapStats
ms {ssSwap :: Int
ssSwap = Int
n forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssSwap SmapStats
ms}
incrSwapPss :: SmapStats -> Maybe Int -> SmapStats
incrSwapPss SmapStats
ms = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SmapStats
ms forall a b. (a -> b) -> a -> b
$ \Int
n -> SmapStats
ms {ssSwapPss :: Int
ssSwapPss = Int
n forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssSwapPss SmapStats
ms}
incrPrivate :: SmapStats -> Maybe Int -> SmapStats
incrPrivate SmapStats
ms = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SmapStats
ms forall a b. (a -> b) -> a -> b
$ \Int
n -> SmapStats
ms {ssPrivate :: Int
ssPrivate = Int
n forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssPrivate SmapStats
ms}
incrShared :: SmapStats -> Maybe Int -> SmapStats
incrShared SmapStats
ms = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SmapStats
ms forall a b. (a -> b) -> a -> b
$ \Int
n -> SmapStats
ms {ssShared :: Int
ssShared = Int
n forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssShared SmapStats
ms}
incrPrivateHuge :: SmapStats -> Maybe Int -> SmapStats
incrPrivateHuge SmapStats
ms = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SmapStats
ms forall a b. (a -> b) -> a -> b
$ \Int
n -> SmapStats
ms {ssPrivateHuge :: Int
ssPrivateHuge = Int
n forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssPrivateHuge SmapStats
ms}
incrSharedHuge :: SmapStats -> Maybe Int -> SmapStats
incrSharedHuge SmapStats
ms = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SmapStats
ms forall a b. (a -> b) -> a -> b
$ \Int
n -> SmapStats
ms {ssSharedHuge :: Int
ssSharedHuge = Int
n forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssSharedHuge SmapStats
ms}


incrSmapStats :: SmapStats -> Text -> SmapStats
incrSmapStats :: SmapStats -> Text -> SmapStats
incrSmapStats SmapStats
acc Text
l =
  if
      | Text -> Text -> Bool
Text.isPrefixOf Text
"Private_Hugetlb:" Text
l -> SmapStats -> Maybe Int -> SmapStats
incrPrivateHuge SmapStats
acc forall a b. (a -> b) -> a -> b
$ forall a. Read a => Text -> Maybe a
smapValMb Text
l
      | Text -> Text -> Bool
Text.isPrefixOf Text
"Shared_Hugetlb:" Text
l -> SmapStats -> Maybe Int -> SmapStats
incrSharedHuge SmapStats
acc forall a b. (a -> b) -> a -> b
$ forall a. Read a => Text -> Maybe a
smapValMb Text
l
      | Text -> Text -> Bool
Text.isPrefixOf Text
"Shared" Text
l -> SmapStats -> Maybe Int -> SmapStats
incrShared SmapStats
acc forall a b. (a -> b) -> a -> b
$ forall a. Read a => Text -> Maybe a
smapValMb Text
l
      | Text -> Text -> Bool
Text.isPrefixOf Text
"Private" Text
l -> SmapStats -> Maybe Int -> SmapStats
incrPrivate SmapStats
acc forall a b. (a -> b) -> a -> b
$ forall a. Read a => Text -> Maybe a
smapValMb Text
l
      | Text -> Text -> Bool
Text.isPrefixOf Text
"Pss:" Text
l ->
          let acc' :: SmapStats
acc' = SmapStats
acc {ssHasPss :: Bool
ssHasPss = Bool
True, ssPssCount :: Int
ssPssCount = Int
1 forall a. Num a => a -> a -> a
+ SmapStats -> Int
ssPssCount SmapStats
acc}
           in SmapStats -> Maybe Int -> SmapStats
incrPss SmapStats
acc' forall a b. (a -> b) -> a -> b
$ forall a. Read a => Text -> Maybe a
smapValMb Text
l
      | Text -> Text -> Bool
Text.isPrefixOf Text
"Swap:" Text
l -> SmapStats -> Maybe Int -> SmapStats
incrSwap SmapStats
acc forall a b. (a -> b) -> a -> b
$ forall a. Read a => Text -> Maybe a
smapValMb Text
l
      | Text -> Text -> Bool
Text.isPrefixOf Text
"SwapPss:" Text
l -> SmapStats -> Maybe Int -> SmapStats
incrSwapPss (SmapStats
acc {ssHasSwapPss :: Bool
ssHasSwapPss = Bool
True}) forall a b. (a -> b) -> a -> b
$ forall a. Read a => Text -> Maybe a
smapValMb Text
l
      | Bool
otherwise -> SmapStats
acc


smapValMb :: Read a => Text -> Maybe a
smapValMb :: forall a. Read a => Text -> Maybe a
smapValMb Text
l =
  let memWords :: [Text]
memWords = Text -> [Text]
Text.words Text
l
      readVal :: [Text] -> Maybe a
readVal (Text
_ : Text
x : [Text]
_) = forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
x
      readVal [Text]
_ = forall a. Maybe a
Nothing
   in forall {a}. Read a => [Text] -> Maybe a
readVal [Text]
memWords