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

This module defines the command line flags used to control the behavior of the
__printmem__ command
-}
module System.MemInfo.Choices (
  Choices (..),
  cmdInfo,
  getChoices,
) where

import Options.Applicative (
  Parser,
  ParserInfo,
  ReadM,
  auto,
  execParser,
  help,
  helper,
  info,
  long,
  metavar,
  option,
  optional,
  readerError,
  short,
  switch,
 )
import Options.Applicative.NonEmpty (some1)
import System.MemInfo.Prelude


-- | Parses the command line arguments.
getChoices :: IO Choices
getChoices :: IO Choices
getChoices = forall a. ParserInfo a -> IO a
execParser ParserInfo Choices
cmdInfo


-- | Represents the user-specified choices extracted from the command line
data Choices = Choices
  { Choices -> Bool
choiceSplitArgs :: !Bool
  , Choices -> Bool
choiceOnlyTotal :: !Bool
  , Choices -> Bool
choiceByPid :: !Bool
  , Choices -> Bool
choiceShowSwap :: !Bool
  , Choices -> Maybe Natural
choiceWatchSecs :: !(Maybe Natural)
  , Choices -> Maybe (NonEmpty ProcessID)
choicePidsToShow :: !(Maybe (NonEmpty ProcessID))
  }
  deriving (Choices -> Choices -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Choices -> Choices -> Bool
$c/= :: Choices -> Choices -> Bool
== :: Choices -> Choices -> Bool
$c== :: Choices -> Choices -> Bool
Eq, Int -> Choices -> ShowS
[Choices] -> ShowS
Choices -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Choices] -> ShowS
$cshowList :: [Choices] -> ShowS
show :: Choices -> String
$cshow :: Choices -> String
showsPrec :: Int -> Choices -> ShowS
$cshowsPrec :: Int -> Choices -> ShowS
Show)


-- | Specifies a command line that when parsed will provide 'Choices'
cmdInfo :: ParserInfo Choices
cmdInfo :: ParserInfo Choices
cmdInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Choices
parseChoices) forall a. Monoid a => a
mempty


parseChoices :: Parser Choices
parseChoices :: Parser Choices
parseChoices =
  Bool
-> Bool
-> Bool
-> Bool
-> Maybe Natural
-> Maybe (NonEmpty ProcessID)
-> Choices
Choices
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseSplitArgs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseOnlyTotal
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseDiscriminateByPid
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseShowSwap
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
parseWatchPeriodSecs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (NonEmpty ProcessID)
parseChoicesPidsToShow


parseChoicesPidsToShow :: Parser (NonEmpty ProcessID)
parseChoicesPidsToShow :: Parser (NonEmpty ProcessID)
parseChoicesPidsToShow =
  forall a. Parser a -> Parser (NonEmpty a)
some1 forall a b. (a -> b) -> a -> b
$
    forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. (Read a, Ord a, Num a) => ReadM a
positiveNum forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pids"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"<pid1> [ -p pid2 ... -p pidN ]"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only show memory usage of the specified PIDs"


parseSplitArgs :: Parser Bool
parseSplitArgs :: Parser Bool
parseSplitArgs =
  Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"split-args"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Show and separate by all command line arguments"


parseOnlyTotal :: Parser Bool
parseOnlyTotal :: Parser Bool
parseOnlyTotal =
  Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"total"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only show the total value"


parseDiscriminateByPid :: Parser Bool
parseDiscriminateByPid :: Parser Bool
parseDiscriminateByPid =
  Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"discriminate-by-pid"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Show by process rather than by program"


parseShowSwap :: Parser Bool
parseShowSwap :: Parser Bool
parseShowSwap =
  Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'S'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show_swap"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Show swap information"


parseWatchPeriodSecs :: Parser Natural
parseWatchPeriodSecs :: Parser Natural
parseWatchPeriodSecs =
  forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. (Read a, Ord a, Num a) => ReadM a
positiveNum forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'w'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"watch"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"N"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Measure and show memory every N seconds (N > 0)"


positiveNum :: (Read a, Ord a, Num a) => ReadM a
positiveNum :: forall a. (Read a, Ord a, Num a) => ReadM a
positiveNum =
  let
    checkPositive :: a -> ReadM a
checkPositive a
i
      | a
i forall a. Ord a => a -> a -> Bool
> a
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
i
      | Bool
otherwise = forall a. String -> ReadM a
readerError String
"Value must be greater than 0"
   in
    forall a. Read a => ReadM a
auto forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. (Ord a, Num a) => a -> ReadM a
checkPositive