{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

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

This module provides functions that format the output of the __printmem__ command
-}
module System.MemInfo.Print (
  AsCmdName (..),
  fmtAsHeader,
  fmtOverall,
  fmtMemUsage,
) where

import qualified Data.Text as Text
import Fmt (
  fixedF,
  padBothF,
  padLeftF,
  padRightF,
  (+|),
  (+||),
  (|+),
  (|++|),
  (||+),
 )
import System.MemInfo.Prelude
import System.MemInfo.Proc (MemUsage (..))


{- | Generates the text of a row displaying the metrics for a single command in
the memory report
-}
fmtMemUsage :: AsCmdName a => Bool -> a -> MemUsage -> Text
fmtMemUsage :: forall a. AsCmdName a => Bool -> a -> MemUsage -> Text
fmtMemUsage Bool
showSwap a
name MemUsage
ct =
  let
    padl :: Int -> Builder
padl = Int -> Char -> Text -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
padLeftF Int
columnWidth Char
' ' (Text -> Builder) -> (Int -> Text) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
fmtMem
    private :: Builder
private = Int -> Builder
padl (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ MemUsage -> Int
muPrivate MemUsage
ct Int -> Int -> Int
forall a. Num a => a -> a -> a
- MemUsage -> Int
muShared MemUsage
ct
    shared :: Builder
shared = Int -> Builder
padl (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ MemUsage -> Int
muShared MemUsage
ct
    all' :: Builder
all' = Int -> Builder
padl (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ MemUsage -> Int
muPrivate MemUsage
ct
    swap' :: Builder
swap' = Int -> Builder
padl (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ MemUsage -> Int
muSwap MemUsage
ct
    name' :: Text
name' = a -> Int -> Text
forall a. AsCmdName a => a -> Int -> Text
cmdWithCount a
name (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ MemUsage -> Int
muCount MemUsage
ct
    ram :: Text
ram = Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
private Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" + " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
shared Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" = " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
all' Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    label :: Text
label = Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
name' Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
   in
    if Bool
showSwap
      then Text
ram Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
swap' Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\t") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label
      else Text
ram Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label


-- | Generates the text showing the overall memory in the memory report
fmtOverall :: Bool -> (Int, Int) -> Text
fmtOverall :: Bool -> (Int, Int) -> Text
fmtOverall Bool
showSwap (Int
private, Int
swap) =
  let
    rimLength :: Int
rimLength = if Bool
showSwap then Int
46 else Int
36
    gapLength :: Int
gapLength = Int
26
    top :: Text
top = Int -> Text -> Text
Text.replicate Int
rimLength Text
"-"
    gap :: Text
gap = Int -> Text -> Text
Text.replicate Int
gapLength Text
" "
    bottom :: Text
bottom = Int -> Text -> Text
Text.replicate Int
rimLength Text
"="
    padl :: Int -> Builder
padl = Int -> Char -> Text -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
padLeftF Int
columnWidth Char
' ' (Text -> Builder) -> (Int -> Text) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
fmtMem
    withSwap :: Text
withSwap = Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
gap Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|++| Int -> Builder
padl Int
private Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|++| Int -> Builder
padl Int
swap Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    noSwap :: Text
noSwap = Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
gap Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|++| Int -> Builder
padl Int
private Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    out :: Text
out = if Bool
showSwap then Text
withSwap else Text
noSwap
   in
    [Text] -> Text
Text.unlines [Text
top, Text
out, Text
bottom]


data Power = Ki | Mi | Gi | Ti deriving (Power -> Power -> Bool
(Power -> Power -> Bool) -> (Power -> Power -> Bool) -> Eq Power
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Power -> Power -> Bool
== :: Power -> Power -> Bool
$c/= :: Power -> Power -> Bool
/= :: Power -> Power -> Bool
Eq, Int -> Power -> ShowS
[Power] -> ShowS
Power -> String
(Int -> Power -> ShowS)
-> (Power -> String) -> ([Power] -> ShowS) -> Show Power
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Power -> ShowS
showsPrec :: Int -> Power -> ShowS
$cshow :: Power -> String
show :: Power -> String
$cshowList :: [Power] -> ShowS
showList :: [Power] -> ShowS
Show, Eq Power
Eq Power =>
(Power -> Power -> Ordering)
-> (Power -> Power -> Bool)
-> (Power -> Power -> Bool)
-> (Power -> Power -> Bool)
-> (Power -> Power -> Bool)
-> (Power -> Power -> Power)
-> (Power -> Power -> Power)
-> Ord Power
Power -> Power -> Bool
Power -> Power -> Ordering
Power -> Power -> Power
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 :: Power -> Power -> Ordering
compare :: Power -> Power -> Ordering
$c< :: Power -> Power -> Bool
< :: Power -> Power -> Bool
$c<= :: Power -> Power -> Bool
<= :: Power -> Power -> Bool
$c> :: Power -> Power -> Bool
> :: Power -> Power -> Bool
$c>= :: Power -> Power -> Bool
>= :: Power -> Power -> Bool
$cmax :: Power -> Power -> Power
max :: Power -> Power -> Power
$cmin :: Power -> Power -> Power
min :: Power -> Power -> Power
Ord, Int -> Power
Power -> Int
Power -> [Power]
Power -> Power
Power -> Power -> [Power]
Power -> Power -> Power -> [Power]
(Power -> Power)
-> (Power -> Power)
-> (Int -> Power)
-> (Power -> Int)
-> (Power -> [Power])
-> (Power -> Power -> [Power])
-> (Power -> Power -> [Power])
-> (Power -> Power -> Power -> [Power])
-> Enum Power
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Power -> Power
succ :: Power -> Power
$cpred :: Power -> Power
pred :: Power -> Power
$ctoEnum :: Int -> Power
toEnum :: Int -> Power
$cfromEnum :: Power -> Int
fromEnum :: Power -> Int
$cenumFrom :: Power -> [Power]
enumFrom :: Power -> [Power]
$cenumFromThen :: Power -> Power -> [Power]
enumFromThen :: Power -> Power -> [Power]
$cenumFromTo :: Power -> Power -> [Power]
enumFromTo :: Power -> Power -> [Power]
$cenumFromThenTo :: Power -> Power -> Power -> [Power]
enumFromThenTo :: Power -> Power -> Power -> [Power]
Enum, Power
Power -> Power -> Bounded Power
forall a. a -> a -> Bounded a
$cminBound :: Power
minBound :: Power
$cmaxBound :: Power
maxBound :: Power
Bounded)


fmtMem :: Int -> Text
fmtMem :: Int -> Text
fmtMem = Power -> Float -> Text
fmtMem' Power
Ki (Float -> Text) -> (Int -> Float) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral


columnWidth :: Int
columnWidth :: Int
columnWidth = Int
10


fmtMem' :: Power -> Float -> Text
fmtMem' :: Power -> Float -> Text
fmtMem' =
  let doFmt :: a -> a -> b
doFmt a
p a
x = Builder
"" Builder -> Builder -> b
forall b. FromBuilder b => Builder -> Builder -> b
+| Int -> a -> Builder
forall a. Real a => Int -> a -> Builder
fixedF Int
1 a
x Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|| a
p a -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+ Builder
"B"
      go :: Power -> Float -> Text
go Power
p Float
x | Power
p Power -> Power -> Bool
forall a. Eq a => a -> a -> Bool
== Power
forall a. Bounded a => a
maxBound = Power -> Float -> Text
forall {b} {a} {a}. (FromBuilder b, Real a, Show a) => a -> a -> b
doFmt Power
p Float
x
      go Power
p Float
x | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
1000 = Power -> Float -> Text
fmtMem' (Power -> Power
forall a. Enum a => a -> a
succ Power
p) (Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1024)
      go Power
p Float
x = Power -> Float -> Text
forall {b} {a} {a}. (FromBuilder b, Real a, Show a) => a -> a -> b
doFmt Power
p Float
x
   in Power -> Float -> Text
go


hdrPrivate, hdrShared, hdrRamUsed, hdrSwapUsed, hdrProgram :: Text
hdrPrivate :: Text
hdrPrivate = Text
"Private"
hdrShared :: Text
hdrShared = Text
"Shared"
hdrRamUsed :: Text
hdrRamUsed = Text
"RAM Used"
hdrSwapUsed :: Text
hdrSwapUsed = Text
"Swap Used"
hdrProgram :: Text
hdrProgram = Text
"Program"


-- | Generates the text of the printed header of the memory report
fmtAsHeader :: Bool -> Text
fmtAsHeader :: Bool -> Text
fmtAsHeader Bool
showSwap =
  let
    padb :: Text -> Builder
padb = Int -> Char -> Text -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
padBothF Int
columnWidth Char
' '
    padr :: Text -> Builder
padr = Int -> Char -> Text -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
padRightF Int
columnWidth Char
' '
    padl :: Text -> Builder
padl = Int -> Char -> Text -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
padLeftF Int
columnWidth Char
' '
    private :: Builder
private = Text -> Builder
padb Text
hdrPrivate
    shared :: Builder
shared = Text -> Builder
padb Text
hdrShared
    all' :: Builder
all' = Text -> Builder
padl Text
hdrRamUsed
    name' :: Builder
name' = Text -> Builder
padr Text
hdrProgram
    swap' :: Builder
swap' = Text -> Builder
padl Text
hdrSwapUsed
    ram :: Text
ram = Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
private Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" + " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
shared Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" = " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
all' Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    label :: Text
label = Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
name' Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
   in
    if Bool
showSwap
      then Text
ram Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
swap' Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\t") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label
      else Text
ram Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label


cmdWithCount :: AsCmdName a => a -> Int -> Text
cmdWithCount :: forall a. AsCmdName a => a -> Int -> Text
cmdWithCount a
cmd Int
count = Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| a -> Text
forall a. AsCmdName a => a -> Text
asCmdName a
cmd Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
count Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")"


{- | Identifies a type as a label to use to index programs in the report
output

The label is also used to group related processes under a single program
-}
class AsCmdName a where
  -- Convert the label to text to print in the report output
  asCmdName :: a -> Text


instance AsCmdName Text where
  asCmdName :: Text -> Text
asCmdName = Text -> Text
forall a. a -> a
id


instance AsCmdName (ProcessID, Text) where
  asCmdName :: (ProcessID, Text) -> Text
asCmdName (ProcessID
pid, Text
name) = Builder
"" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
name Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" [" Builder -> Builder -> Builder
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
"]"