{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

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

This module provides data types that

- define memory reports (cf @'ReportBud'@) and

- provide info about the system where the report will run (cf @'KernelVersion'@,
@'SwapFlaw'@ and @'RamFlaw'@).

along with functions that use these types.
-}
module System.MemInfo.SysInfo (
  -- * define reports
  ReportBud (..),
  mkReportBud,

  -- * indicate calculation flaws
  RamFlaw (..),
  SwapFlaw (..),
  checkForFlaws,
  fmtRamFlaws,
  fmtSwapFlaws,

  -- * system kernel version
  KernelVersion,
  parseKernelVersion,
  readKernelVersion,
  fickleSharing,
) where

import qualified Data.List.NonEmpty as NE
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Read as Text
import Fmt ((+|), (|+))
import System.MemInfo.Prelude


-- | Represents a version of @Linux@ kernel
type KernelVersion = (Natural, Natural, Natural)


{- | On linux kernels before smaps became available, there was no reliable way to
determine how much of a processes memory was shared

http://lkml.org/lkml/2005/7/6/250
-}
fickleSharing :: KernelVersion -> Bool
fickleSharing :: KernelVersion -> Bool
fickleSharing KernelVersion
k = KernelVersion
k KernelVersion -> KernelVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= (Natural
2, Natural
6, Natural
1) Bool -> Bool -> Bool
&& KernelVersion
k KernelVersion -> KernelVersion -> Bool
forall a. Ord a => a -> a -> Bool
<= (Natural
2, Natural
6, Natural
9)


-- | Determines the version of the Linux kernel on the current system.
readKernelVersion :: IO (Maybe KernelVersion)
readKernelVersion :: IO (Maybe KernelVersion)
readKernelVersion = Text -> Maybe KernelVersion
parseKernelVersion (Text -> Maybe KernelVersion)
-> IO Text -> IO (Maybe KernelVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
Text.readFile FilePath
kernelVersionPath


kernelVersionPath :: String
kernelVersionPath :: FilePath
kernelVersionPath = FilePath
"/proc/sys/kernel/osrelease"


-- | Parses @Text@ into a @'KernelVersion'@
parseKernelVersion :: Text -> Maybe KernelVersion
parseKernelVersion :: Text -> Maybe KernelVersion
parseKernelVersion =
  let unrecognized :: Maybe a
unrecognized = Maybe a
forall a. Maybe a
Nothing
      dec' :: Either a (a, Text) -> Maybe a
dec' (Right (a
x, Text
extra)) | Text -> Bool
Text.null Text
extra = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      dec' Either a (a, Text)
_ = Maybe a
forall a. Maybe a
unrecognized
      dec1st' :: Either a (a, b) -> Maybe a
dec1st' (Right (a
x, b
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      dec1st' Either a (a, b)
_ = Maybe a
forall a. Maybe a
unrecognized

      dec :: Text -> Maybe Natural
dec = Either FilePath (Natural, Text) -> Maybe Natural
forall {a} {a}. Either a (a, Text) -> Maybe a
dec' (Either FilePath (Natural, Text) -> Maybe Natural)
-> (Text -> Either FilePath (Natural, Text))
-> Text
-> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath (Natural, Text)
forall a. Integral a => Reader a
Text.decimal
      dec1st :: Text -> Maybe Natural
dec1st = Either FilePath (Natural, Text) -> Maybe Natural
forall {a} {a} {b}. Either a (a, b) -> Maybe a
dec1st' (Either FilePath (Natural, Text) -> Maybe Natural)
-> (Text -> Either FilePath (Natural, Text))
-> Text
-> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath (Natural, Text)
forall a. Integral a => Reader a
Text.decimal
      fromSplit :: [Text] -> Maybe KernelVersion
fromSplit [Text
x] = (,,) (Natural -> Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> Natural -> KernelVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Natural
dec Text
x Maybe (Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> KernelVersion)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Maybe Natural
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
0 Maybe (Natural -> KernelVersion)
-> Maybe Natural -> Maybe KernelVersion
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Maybe Natural
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
0
      fromSplit [Text
x, Text
y] = (,,) (Natural -> Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> Natural -> KernelVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Natural
dec Text
x Maybe (Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> KernelVersion)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Natural
dec1st Text
y Maybe (Natural -> KernelVersion)
-> Maybe Natural -> Maybe KernelVersion
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Maybe Natural
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
0
      fromSplit [Text
x, Text
y, Text
z] = (,,) (Natural -> Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> Natural -> KernelVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Natural
dec Text
x Maybe (Natural -> Natural -> KernelVersion)
-> Maybe Natural -> Maybe (Natural -> KernelVersion)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Natural
dec Text
y Maybe (Natural -> KernelVersion)
-> Maybe Natural -> Maybe KernelVersion
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Natural
dec1st Text
z
      fromSplit [Text]
_ = Maybe KernelVersion
forall a. Maybe a
unrecognized
   in [Text] -> Maybe KernelVersion
fromSplit ([Text] -> Maybe KernelVersion)
-> (Text -> [Text]) -> Text -> Maybe KernelVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')


-- | Gathers the inputs needed to generate a memory usage report
data ReportBud = ReportBud
  { ReportBud -> NonEmpty ProcessID
rbPids :: !(NonEmpty ProcessID)
  , ReportBud -> KernelVersion
rbKernel :: !KernelVersion
  , ReportBud -> Bool
rbHasPss :: !Bool
  , ReportBud -> Bool
rbHasSwapPss :: !Bool
  , ReportBud -> Bool
rbHasSmaps :: !Bool
  , ReportBud -> Maybe RamFlaw
rbRamFlaws :: Maybe RamFlaw
  , ReportBud -> Maybe SwapFlaw
rbSwapFlaws :: Maybe SwapFlaw
  }
  deriving (ReportBud -> ReportBud -> Bool
(ReportBud -> ReportBud -> Bool)
-> (ReportBud -> ReportBud -> Bool) -> Eq ReportBud
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportBud -> ReportBud -> Bool
== :: ReportBud -> ReportBud -> Bool
$c/= :: ReportBud -> ReportBud -> Bool
/= :: ReportBud -> ReportBud -> Bool
Eq, Int -> ReportBud -> ShowS
[ReportBud] -> ShowS
ReportBud -> FilePath
(Int -> ReportBud -> ShowS)
-> (ReportBud -> FilePath)
-> ([ReportBud] -> ShowS)
-> Show ReportBud
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportBud -> ShowS
showsPrec :: Int -> ReportBud -> ShowS
$cshow :: ReportBud -> FilePath
show :: ReportBud -> FilePath
$cshowList :: [ReportBud] -> ShowS
showList :: [ReportBud] -> ShowS
Show)


-- | Describes inaccuracies in the RAM calculation
data RamFlaw
  = -- | no shared mem is reported
    NoSharedMem
  | -- | some shared mem not reported
    SomeSharedMem
  | -- | accurate only considering each process in isolation
    ExactForIsolatedMem
  deriving (RamFlaw -> RamFlaw -> Bool
(RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> Bool) -> Eq RamFlaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RamFlaw -> RamFlaw -> Bool
== :: RamFlaw -> RamFlaw -> Bool
$c/= :: RamFlaw -> RamFlaw -> Bool
/= :: RamFlaw -> RamFlaw -> Bool
Eq, Int -> RamFlaw -> ShowS
[RamFlaw] -> ShowS
RamFlaw -> FilePath
(Int -> RamFlaw -> ShowS)
-> (RamFlaw -> FilePath) -> ([RamFlaw] -> ShowS) -> Show RamFlaw
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RamFlaw -> ShowS
showsPrec :: Int -> RamFlaw -> ShowS
$cshow :: RamFlaw -> FilePath
show :: RamFlaw -> FilePath
$cshowList :: [RamFlaw] -> ShowS
showList :: [RamFlaw] -> ShowS
Show, Eq RamFlaw
Eq RamFlaw =>
(RamFlaw -> RamFlaw -> Ordering)
-> (RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> Bool)
-> (RamFlaw -> RamFlaw -> RamFlaw)
-> (RamFlaw -> RamFlaw -> RamFlaw)
-> Ord RamFlaw
RamFlaw -> RamFlaw -> Bool
RamFlaw -> RamFlaw -> Ordering
RamFlaw -> RamFlaw -> RamFlaw
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RamFlaw -> RamFlaw -> Ordering
compare :: RamFlaw -> RamFlaw -> Ordering
$c< :: RamFlaw -> RamFlaw -> Bool
< :: RamFlaw -> RamFlaw -> Bool
$c<= :: RamFlaw -> RamFlaw -> Bool
<= :: RamFlaw -> RamFlaw -> Bool
$c> :: RamFlaw -> RamFlaw -> Bool
> :: RamFlaw -> RamFlaw -> Bool
$c>= :: RamFlaw -> RamFlaw -> Bool
>= :: RamFlaw -> RamFlaw -> Bool
$cmax :: RamFlaw -> RamFlaw -> RamFlaw
max :: RamFlaw -> RamFlaw -> RamFlaw
$cmin :: RamFlaw -> RamFlaw -> RamFlaw
min :: RamFlaw -> RamFlaw -> RamFlaw
Ord)


-- | Provide @Text@ that explains the 'RamFlaw'
fmtRamFlaws :: RamFlaw -> Text
fmtRamFlaws :: RamFlaw -> Text
fmtRamFlaws RamFlaw
NoSharedMem =
  [Text] -> Text
Text.unlines
    [ Text
"shared memory is not reported by this system."
    , Text
"Values reported will be too large, and totals are not reported"
    ]
fmtRamFlaws RamFlaw
SomeSharedMem =
  [Text] -> Text
Text.unlines
    [ Text
"shared memory is not reported accurately by this system."
    , Text
"Values reported could be too large, and totals are not reported"
    ]
fmtRamFlaws RamFlaw
ExactForIsolatedMem =
  [Text] -> Text
Text.unlines
    [ Text
"shared memory is slightly over-estimated by this system"
    , Text
"for each program, so totals are not reported."
    ]


-- | Describes inaccuracies in the swap measurement
data SwapFlaw
  = -- | not available
    NoSwap
  | -- | accurate only considering each process in isolation
    ExactForIsolatedSwap
  deriving (SwapFlaw -> SwapFlaw -> Bool
(SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> Bool) -> Eq SwapFlaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwapFlaw -> SwapFlaw -> Bool
== :: SwapFlaw -> SwapFlaw -> Bool
$c/= :: SwapFlaw -> SwapFlaw -> Bool
/= :: SwapFlaw -> SwapFlaw -> Bool
Eq, Int -> SwapFlaw -> ShowS
[SwapFlaw] -> ShowS
SwapFlaw -> FilePath
(Int -> SwapFlaw -> ShowS)
-> (SwapFlaw -> FilePath) -> ([SwapFlaw] -> ShowS) -> Show SwapFlaw
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SwapFlaw -> ShowS
showsPrec :: Int -> SwapFlaw -> ShowS
$cshow :: SwapFlaw -> FilePath
show :: SwapFlaw -> FilePath
$cshowList :: [SwapFlaw] -> ShowS
showList :: [SwapFlaw] -> ShowS
Show, Eq SwapFlaw
Eq SwapFlaw =>
(SwapFlaw -> SwapFlaw -> Ordering)
-> (SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> Bool)
-> (SwapFlaw -> SwapFlaw -> SwapFlaw)
-> (SwapFlaw -> SwapFlaw -> SwapFlaw)
-> Ord SwapFlaw
SwapFlaw -> SwapFlaw -> Bool
SwapFlaw -> SwapFlaw -> Ordering
SwapFlaw -> SwapFlaw -> SwapFlaw
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SwapFlaw -> SwapFlaw -> Ordering
compare :: SwapFlaw -> SwapFlaw -> Ordering
$c< :: SwapFlaw -> SwapFlaw -> Bool
< :: SwapFlaw -> SwapFlaw -> Bool
$c<= :: SwapFlaw -> SwapFlaw -> Bool
<= :: SwapFlaw -> SwapFlaw -> Bool
$c> :: SwapFlaw -> SwapFlaw -> Bool
> :: SwapFlaw -> SwapFlaw -> Bool
$c>= :: SwapFlaw -> SwapFlaw -> Bool
>= :: SwapFlaw -> SwapFlaw -> Bool
$cmax :: SwapFlaw -> SwapFlaw -> SwapFlaw
max :: SwapFlaw -> SwapFlaw -> SwapFlaw
$cmin :: SwapFlaw -> SwapFlaw -> SwapFlaw
min :: SwapFlaw -> SwapFlaw -> SwapFlaw
Ord)


-- | Provide @Text@ that explains the 'SwapFlaw'
fmtSwapFlaws :: SwapFlaw -> Text
fmtSwapFlaws :: SwapFlaw -> Text
fmtSwapFlaws SwapFlaw
NoSwap = Text
"swap is not reported by this system."
fmtSwapFlaws SwapFlaw
ExactForIsolatedSwap =
  [Text] -> Text
Text.unlines
    [ Text
"swap is over-estimated by this system"
    , Text
"for each program, so totals are not reported."
    ]


{- | Examine the target system for @'RamFlaw's@ and @'SwapFlaw's@, and update
@bud@ reflect the findings.
-}
checkForFlaws :: ReportBud -> IO ReportBud
checkForFlaws :: ReportBud -> IO ReportBud
checkForFlaws ReportBud
bud = do
  let pid :: ProcessID
pid = NonEmpty ProcessID -> ProcessID
forall a. NonEmpty a -> a
NE.head (NonEmpty ProcessID -> ProcessID)
-> NonEmpty ProcessID -> ProcessID
forall a b. (a -> b) -> a -> b
$ ReportBud -> NonEmpty ProcessID
rbPids ReportBud
bud
      version :: KernelVersion
version = ReportBud -> KernelVersion
rbKernel ReportBud
bud
      fickleShared :: Bool
fickleShared = KernelVersion -> Bool
fickleSharing KernelVersion
version
      ReportBud
        { rbHasPss :: ReportBud -> Bool
rbHasPss = Bool
hasPss
        , rbHasSmaps :: ReportBud -> Bool
rbHasSmaps = Bool
hasSmaps
        , rbHasSwapPss :: ReportBud -> Bool
rbHasSwapPss = Bool
hasSwapPss
        } = ReportBud
bud
  (Maybe RamFlaw
rbRamFlaws, Maybe SwapFlaw
rbSwapFlaws) <- case KernelVersion
version of
    (Natural
2, Natural
4, Natural
_) -> do
      let memInfoPath :: FilePath
memInfoPath = FilePath -> ProcessID -> FilePath
pidPath FilePath
"meminfo" ProcessID
pid
          alt :: (Maybe RamFlaw, Maybe SwapFlaw)
alt = (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just RamFlaw
SomeSharedMem, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
NoSwap)
          best :: (Maybe RamFlaw, Maybe SwapFlaw)
best = (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just RamFlaw
ExactForIsolatedMem, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
NoSwap)
          containsInact :: Text -> Bool
containsInact = Text -> Text -> Bool
Text.isInfixOf Text
"Inact_"
          checkInact :: Text -> (Maybe RamFlaw, Maybe SwapFlaw)
checkInact Text
x = if Text -> Bool
containsInact Text
x then (Maybe RamFlaw, Maybe SwapFlaw)
best else (Maybe RamFlaw, Maybe SwapFlaw)
alt
      FilePath -> IO Bool
doesFileExist FilePath
memInfoPath IO Bool
-> (Bool -> IO (Maybe RamFlaw, Maybe SwapFlaw))
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
False -> (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RamFlaw, Maybe SwapFlaw)
alt
        Bool
_ -> Text -> (Maybe RamFlaw, Maybe SwapFlaw)
checkInact (Text -> (Maybe RamFlaw, Maybe SwapFlaw))
-> IO Text -> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readUtf8Text FilePath
memInfoPath
    (Natural
2, Natural
6, Natural
_) -> do
      let withSmaps :: (Maybe RamFlaw, Maybe SwapFlaw)
withSmaps = if Bool
hasPss then (Maybe RamFlaw, Maybe SwapFlaw)
forall {a}. (Maybe a, Maybe SwapFlaw)
best else (Maybe RamFlaw, Maybe SwapFlaw)
alt
          alt :: (Maybe RamFlaw, Maybe SwapFlaw)
alt = (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just RamFlaw
ExactForIsolatedMem, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
ExactForIsolatedSwap)
          best :: (Maybe a, Maybe SwapFlaw)
best = (Maybe a
forall a. Maybe a
Nothing, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
ExactForIsolatedSwap)
          withNoSmaps :: Maybe RamFlaw
withNoSmaps = RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just (RamFlaw -> Maybe RamFlaw) -> RamFlaw -> Maybe RamFlaw
forall a b. (a -> b) -> a -> b
$ if Bool
fickleShared then RamFlaw
NoSharedMem else RamFlaw
SomeSharedMem
      (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe RamFlaw, Maybe SwapFlaw)
 -> IO (Maybe RamFlaw, Maybe SwapFlaw))
-> (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a b. (a -> b) -> a -> b
$ if Bool
hasSmaps then (Maybe RamFlaw, Maybe SwapFlaw)
withSmaps else (Maybe RamFlaw
withNoSmaps, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
NoSwap)
    (Natural
major, Natural
_, Natural
_) | Natural
major Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
2 Bool -> Bool -> Bool
&& Bool
hasSmaps -> do
      let alt :: (Maybe a, Maybe SwapFlaw)
alt = (Maybe a
forall a. Maybe a
Nothing, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
ExactForIsolatedSwap)
          best :: (Maybe a, Maybe a)
best = (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
      (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe RamFlaw, Maybe SwapFlaw)
 -> IO (Maybe RamFlaw, Maybe SwapFlaw))
-> (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a b. (a -> b) -> a -> b
$ if Bool
hasSwapPss then (Maybe RamFlaw, Maybe SwapFlaw)
forall {a} {a}. (Maybe a, Maybe a)
best else (Maybe RamFlaw, Maybe SwapFlaw)
forall {a}. (Maybe a, Maybe SwapFlaw)
alt
    KernelVersion
_ -> (Maybe RamFlaw, Maybe SwapFlaw)
-> IO (Maybe RamFlaw, Maybe SwapFlaw)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RamFlaw -> Maybe RamFlaw
forall a. a -> Maybe a
Just RamFlaw
ExactForIsolatedMem, SwapFlaw -> Maybe SwapFlaw
forall a. a -> Maybe a
Just SwapFlaw
NoSwap)
  ReportBud -> IO ReportBud
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReportBud -> IO ReportBud) -> ReportBud -> IO ReportBud
forall a b. (a -> b) -> a -> b
$ ReportBud
bud {rbRamFlaws, rbSwapFlaws}


{- | Construct a @ReportBud@ from some @ProcessIDs@

Generates values for the other fields by inspecting the system

The result is @Nothing@ only when the @KernelVersion@ cannot be determined
-}
mkReportBud :: NonEmpty ProcessID -> IO (Maybe ReportBud)
mkReportBud :: NonEmpty ProcessID -> IO (Maybe ReportBud)
mkReportBud NonEmpty ProcessID
rbPids = do
  let firstPid :: ProcessID
firstPid = NonEmpty ProcessID -> ProcessID
forall a. NonEmpty a -> a
NE.head NonEmpty ProcessID
rbPids
      smapsPath :: FilePath
smapsPath = FilePath -> ProcessID -> FilePath
pidPath FilePath
"smaps" ProcessID
firstPid
      hasPss :: Text -> Bool
hasPss = Text -> Text -> Bool
Text.isInfixOf Text
"Pss:"
      hasSwapPss :: Text -> Bool
hasSwapPss = Text -> Text -> Bool
Text.isInfixOf Text
"SwapPss:"
      memtypes :: Text -> (Bool, Bool)
memtypes Text
x = (Text -> Bool
hasPss Text
x, Text -> Bool
hasSwapPss Text
x)
  Bool
rbHasSmaps <- FilePath -> IO Bool
doesFileExist FilePath
smapsPath
  (Bool
rbHasPss, Bool
rbHasSwapPss) <- Text -> (Bool, Bool)
memtypes (Text -> (Bool, Bool)) -> IO Text -> IO (Bool, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readUtf8Text FilePath
smapsPath
  IO (Maybe KernelVersion)
readKernelVersion IO (Maybe KernelVersion)
-> (Maybe KernelVersion -> IO (Maybe ReportBud))
-> IO (Maybe ReportBud)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe KernelVersion
Nothing -> Maybe ReportBud -> IO (Maybe ReportBud)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ReportBud
forall a. Maybe a
Nothing
    Just KernelVersion
rbKernel ->
      (ReportBud -> Maybe ReportBud)
-> IO ReportBud -> IO (Maybe ReportBud)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ReportBud -> Maybe ReportBud
forall a. a -> Maybe a
Just (IO ReportBud -> IO (Maybe ReportBud))
-> IO ReportBud -> IO (Maybe ReportBud)
forall a b. (a -> b) -> a -> b
$
        ReportBud -> IO ReportBud
checkForFlaws (ReportBud -> IO ReportBud) -> ReportBud -> IO ReportBud
forall a b. (a -> b) -> a -> b
$
          ReportBud
            { NonEmpty ProcessID
rbPids :: NonEmpty ProcessID
rbPids :: NonEmpty ProcessID
rbPids
            , KernelVersion
rbKernel :: KernelVersion
rbKernel :: KernelVersion
rbKernel
            , Bool
rbHasPss :: Bool
rbHasPss :: Bool
rbHasPss
            , Bool
rbHasSwapPss :: Bool
rbHasSwapPss :: Bool
rbHasSwapPss
            , Bool
rbHasSmaps :: Bool
rbHasSmaps :: Bool
rbHasSmaps
            , rbRamFlaws :: Maybe RamFlaw
rbRamFlaws = Maybe RamFlaw
forall a. Maybe a
Nothing
            , rbSwapFlaws :: Maybe SwapFlaw
rbSwapFlaws = Maybe SwapFlaw
forall a. Maybe a
Nothing
            }


pidPath :: String -> ProcessID -> FilePath
pidPath :: FilePath -> ProcessID -> FilePath
pidPath FilePath
base ProcessID
pid = Builder
"/proc/" Builder -> Builder -> FilePath
forall b. FromBuilder b => Builder -> Builder -> b
+| ProcessID -> Integer
forall a. Integral a => a -> Integer
toInteger ProcessID
pid Integer -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"/" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| FilePath
base FilePath -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""