{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
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 (..),
  Style (..),
  PrintOrder (..),
  Power (..),
  Mem (..),
  asFloat,
  memReader,
  cmdInfo,
  getChoices,
) where

import Data.Fixed (Deci)
import qualified Data.Text as Text
import Data.Text.Read (Reader, rational)
import GHC.Generics (Generic)
import Options.Applicative (
  Parser,
  ParserInfo,
  ReadM,
  eitherReader,
  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 = ParserInfo Choices -> IO Choices
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 -> Bool
choiceReversed :: !Bool
  , Choices -> Maybe Natural
choiceWatchSecs :: !(Maybe Natural)
  , Choices -> Maybe (NonEmpty ProcessID)
choicePidsToShow :: !(Maybe (NonEmpty ProcessID))
  , Choices -> Maybe PrintOrder
choicePrintOrder :: !(Maybe PrintOrder)
  , Choices -> Maybe Style
choiceStyle :: !(Maybe Style)
  , Choices -> Maybe Mem
choiceMinMemory :: !(Maybe Mem)
  }
  deriving (Choices -> Choices -> Bool
(Choices -> Choices -> Bool)
-> (Choices -> Choices -> Bool) -> Eq Choices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Choices -> Choices -> Bool
== :: Choices -> Choices -> Bool
$c/= :: Choices -> Choices -> Bool
/= :: Choices -> Choices -> Bool
Eq, Int -> Choices -> ShowS
[Choices] -> ShowS
Choices -> String
(Int -> Choices -> ShowS)
-> (Choices -> String) -> ([Choices] -> ShowS) -> Show Choices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Choices -> ShowS
showsPrec :: Int -> Choices -> ShowS
$cshow :: Choices -> String
show :: Choices -> String
$cshowList :: [Choices] -> ShowS
showList :: [Choices] -> ShowS
Show, (forall x. Choices -> Rep Choices x)
-> (forall x. Rep Choices x -> Choices) -> Generic Choices
forall x. Rep Choices x -> Choices
forall x. Choices -> Rep Choices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Choices -> Rep Choices x
from :: forall x. Choices -> Rep Choices x
$cto :: forall x. Rep Choices x -> Choices
to :: forall x. Rep Choices x -> Choices
Generic)


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


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


parseChoicesPidsToShow :: Parser (NonEmpty ProcessID)
parseChoicesPidsToShow :: Parser (NonEmpty ProcessID)
parseChoicesPidsToShow =
  Parser ProcessID -> Parser (NonEmpty ProcessID)
forall a. Parser a -> Parser (NonEmpty a)
some1 (Parser ProcessID -> Parser (NonEmpty ProcessID))
-> Parser ProcessID -> Parser (NonEmpty ProcessID)
forall a b. (a -> b) -> a -> b
$
    ReadM ProcessID -> Mod OptionFields ProcessID -> Parser ProcessID
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM ProcessID
forall a. (Read a, Ord a, Num a) => ReadM a
positiveNum (Mod OptionFields ProcessID -> Parser ProcessID)
-> Mod OptionFields ProcessID -> Parser ProcessID
forall a b. (a -> b) -> a -> b
$
      Char -> Mod OptionFields ProcessID
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
        Mod OptionFields ProcessID
-> Mod OptionFields ProcessID -> Mod OptionFields ProcessID
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ProcessID
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pids"
        Mod OptionFields ProcessID
-> Mod OptionFields ProcessID -> Mod OptionFields ProcessID
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ProcessID
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"<pid1> [ -p pid2 ... -p pidN ]"
        Mod OptionFields ProcessID
-> Mod OptionFields ProcessID -> Mod OptionFields ProcessID
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ProcessID
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 (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"split-args"
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
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 (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"total"
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Only show the total value"


parseReversed :: Parser Bool
parseReversed :: Parser Bool
parseReversed =
  Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"reverse"
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Reverses the output order so that output descends on the sorting field"


parseDiscriminateByPid :: Parser Bool
parseDiscriminateByPid :: Parser Bool
parseDiscriminateByPid =
  Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"discriminate-by-pid"
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
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 (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'S'
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show_swap"
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Show swap information"


parseWatchPeriodSecs :: Parser Natural
parseWatchPeriodSecs :: Parser Natural
parseWatchPeriodSecs =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Natural
forall a. (Read a, Ord a, Num a) => ReadM a
positiveNum (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
    Char -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'w'
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"watch"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"N"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = a -> ReadM a
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
i
      | Bool
otherwise = String -> ReadM a
forall a. String -> ReadM a
readerError String
"Value must be greater than 0"
   in
    ReadM a
forall a. Read a => ReadM a
autoOrNotAllowed ReadM a -> (a -> ReadM a) -> ReadM a
forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ReadM a
forall {a}. (Ord a, Num a) => a -> ReadM a
checkPositive


parsePrintOrder :: Parser PrintOrder
parsePrintOrder :: Parser PrintOrder
parsePrintOrder =
  ReadM PrintOrder
-> Mod OptionFields PrintOrder -> Parser PrintOrder
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM PrintOrder
forall a. Read a => ReadM a
autoIgnoreCase (Mod OptionFields PrintOrder -> Parser PrintOrder)
-> Mod OptionFields PrintOrder -> Parser PrintOrder
forall a b. (a -> b) -> a -> b
$
    Char -> Mod OptionFields PrintOrder
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b'
      Mod OptionFields PrintOrder
-> Mod OptionFields PrintOrder -> Mod OptionFields PrintOrder
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PrintOrder
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"order-by"
      Mod OptionFields PrintOrder
-> Mod OptionFields PrintOrder -> Mod OptionFields PrintOrder
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PrintOrder
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"< private | swap | shared | count >"
      Mod OptionFields PrintOrder
-> Mod OptionFields PrintOrder -> Mod OptionFields PrintOrder
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PrintOrder
forall (f :: * -> *) a. String -> Mod f a
help String
"Orders the output by ascending values of the given field"


-- | Determines the order in which @MemUsages@ in a report are printed out
data PrintOrder
  = Swap
  | Private
  | Shared
  | Count
  deriving (PrintOrder -> PrintOrder -> Bool
(PrintOrder -> PrintOrder -> Bool)
-> (PrintOrder -> PrintOrder -> Bool) -> Eq PrintOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrintOrder -> PrintOrder -> Bool
== :: PrintOrder -> PrintOrder -> Bool
$c/= :: PrintOrder -> PrintOrder -> Bool
/= :: PrintOrder -> PrintOrder -> Bool
Eq, Int -> PrintOrder -> ShowS
[PrintOrder] -> ShowS
PrintOrder -> String
(Int -> PrintOrder -> ShowS)
-> (PrintOrder -> String)
-> ([PrintOrder] -> ShowS)
-> Show PrintOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrintOrder -> ShowS
showsPrec :: Int -> PrintOrder -> ShowS
$cshow :: PrintOrder -> String
show :: PrintOrder -> String
$cshowList :: [PrintOrder] -> ShowS
showList :: [PrintOrder] -> ShowS
Show, ReadPrec [PrintOrder]
ReadPrec PrintOrder
Int -> ReadS PrintOrder
ReadS [PrintOrder]
(Int -> ReadS PrintOrder)
-> ReadS [PrintOrder]
-> ReadPrec PrintOrder
-> ReadPrec [PrintOrder]
-> Read PrintOrder
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PrintOrder
readsPrec :: Int -> ReadS PrintOrder
$creadList :: ReadS [PrintOrder]
readList :: ReadS [PrintOrder]
$creadPrec :: ReadPrec PrintOrder
readPrec :: ReadPrec PrintOrder
$creadListPrec :: ReadPrec [PrintOrder]
readListPrec :: ReadPrec [PrintOrder]
Read, (forall x. PrintOrder -> Rep PrintOrder x)
-> (forall x. Rep PrintOrder x -> PrintOrder) -> Generic PrintOrder
forall x. Rep PrintOrder x -> PrintOrder
forall x. PrintOrder -> Rep PrintOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrintOrder -> Rep PrintOrder x
from :: forall x. PrintOrder -> Rep PrintOrder x
$cto :: forall x. Rep PrintOrder x -> PrintOrder
to :: forall x. Rep PrintOrder x -> PrintOrder
Generic)


parseMinReported :: Parser Mem
parseMinReported :: Parser Mem
parseMinReported =
  ReadM Mem -> Mod OptionFields Mem -> Parser Mem
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String Mem) -> ReadM Mem
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String Mem) -> ReadM Mem)
-> (String -> Either String Mem) -> ReadM Mem
forall a b. (a -> b) -> a -> b
$ Reader Mem -> String -> Either String Mem
forall a. Reader a -> String -> Either String a
fromReader Reader Mem
memReader) (Mod OptionFields Mem -> Parser Mem)
-> Mod OptionFields Mem -> Parser Mem
forall a b. (a -> b) -> a -> b
$
    Char -> Mod OptionFields Mem
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm'
      Mod OptionFields Mem
-> Mod OptionFields Mem -> Mod OptionFields Mem
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Mem
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"min-reported"
      Mod OptionFields Mem
-> Mod OptionFields Mem -> Mod OptionFields Mem
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Mem
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"<threshold>[K|M|G|T]iB, e.g 1.1KiB | 2MiB | 4.0GiB"
      Mod OptionFields Mem
-> Mod OptionFields Mem -> Mod OptionFields Mem
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Mem
forall (f :: * -> *) a. String -> Mod f a
help String
"Specifies a minimum below which memory values are omitted"


parseStyle :: Parser Style
parseStyle :: Parser Style
parseStyle =
  ReadM Style -> Mod OptionFields Style -> Parser Style
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Style
forall a. Read a => ReadM a
autoIgnoreCase (Mod OptionFields Style -> Parser Style)
-> Mod OptionFields Style -> Parser Style
forall a b. (a -> b) -> a -> b
$
    Char -> Mod OptionFields Style
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'y'
      Mod OptionFields Style
-> Mod OptionFields Style -> Mod OptionFields Style
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Style
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-style"
      Mod OptionFields Style
-> Mod OptionFields Style -> Mod OptionFields Style
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Style
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"< [normal] | csv >"
      Mod OptionFields Style
-> Mod OptionFields Style -> Mod OptionFields Style
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Style
forall (f :: * -> *) a. String -> Mod f a
help (Text -> String
Text.unpack Text
styleHelp)


styleHelp :: Text
styleHelp :: Text
styleHelp =
  [Text] -> Text
Text.unlines
    [ Text
"Determines how the output report is presented;"
    , Text
"'normal' is the default and is the same as if this option was omitted;"
    , Text
"'csv' outputs the usage and header rows in csv format, with all values in KiB and no 'total' row."
    , Text
"With 'csv', the --total (-t) flag is ignored"
    ]


-- | Determines the format style of the output
data Style
  = Csv
  | Normal
  deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
Eq, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show, ReadPrec [Style]
ReadPrec Style
Int -> ReadS Style
ReadS [Style]
(Int -> ReadS Style)
-> ReadS [Style]
-> ReadPrec Style
-> ReadPrec [Style]
-> Read Style
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Style
readsPrec :: Int -> ReadS Style
$creadList :: ReadS [Style]
readList :: ReadS [Style]
$creadPrec :: ReadPrec Style
readPrec :: ReadPrec Style
$creadListPrec :: ReadPrec [Style]
readListPrec :: ReadPrec [Style]
Read, (forall x. Style -> Rep Style x)
-> (forall x. Rep Style x -> Style) -> Generic Style
forall x. Rep Style x -> Style
forall x. Style -> Rep Style x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Style -> Rep Style x
from :: forall x. Style -> Rep Style x
$cto :: forall x. Rep Style x -> Style
to :: forall x. Rep Style x -> Style
Generic)


autoIgnoreCase :: (Read a) => ReadM a
autoIgnoreCase :: forall a. Read a => ReadM a
autoIgnoreCase =
  let toTitle' :: ShowS
toTitle' = Text -> String
Text.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toTitle (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
   in (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String a) -> ReadM a)
-> (String -> Either String a) -> ReadM a
forall a b. (a -> b) -> a -> b
$ ShowS -> String -> Either String a
forall a. Read a => ShowS -> String -> Either String a
readOrNotAllowed ShowS
toTitle'


autoOrNotAllowed :: (Read a) => ReadM a
autoOrNotAllowed :: forall a. Read a => ReadM a
autoOrNotAllowed = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String a) -> ReadM a)
-> (String -> Either String a) -> ReadM a
forall a b. (a -> b) -> a -> b
$ ShowS -> String -> Either String a
forall a. Read a => ShowS -> String -> Either String a
readOrNotAllowed ShowS
forall a. a -> a
id


readOrNotAllowed :: (Read a) => (String -> String) -> String -> Either String a
readOrNotAllowed :: forall a. Read a => ShowS -> String -> Either String a
readOrNotAllowed ShowS
f String
x = case String -> Either String a
forall a. Read a => String -> Either String a
readEither (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ ShowS
f String
x of
  Left String
_ignored -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"value '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is not permitted"
  Either String a
right -> Either String a
right


fromReader :: Reader a -> String -> Either String a
fromReader :: forall a. Reader a -> String -> Either String a
fromReader Reader a
reader = ((a, Text) -> a) -> Either String (a, Text) -> Either String a
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Text) -> a
forall a b. (a, b) -> a
fst (Either String (a, Text) -> Either String a)
-> (String -> Either String (a, Text)) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader a
reader Reader a -> (String -> Text) -> String -> Either String (a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack


-- | Represents the power in memory quanity unit
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, ReadPrec [Power]
ReadPrec Power
Int -> ReadS Power
ReadS [Power]
(Int -> ReadS Power)
-> ReadS [Power]
-> ReadPrec Power
-> ReadPrec [Power]
-> Read Power
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Power
readsPrec :: Int -> ReadS Power
$creadList :: ReadS [Power]
readList :: ReadS [Power]
$creadPrec :: ReadPrec Power
readPrec :: ReadPrec Power
$creadListPrec :: ReadPrec [Power]
readListPrec :: ReadPrec [Power]
Read, 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, (forall x. Power -> Rep Power x)
-> (forall x. Rep Power x -> Power) -> Generic Power
forall x. Rep Power x -> Power
forall x. Power -> Rep Power x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Power -> Rep Power x
from :: forall x. Power -> Rep Power x
$cto :: forall x. Rep Power x -> Power
to :: forall x. Rep Power x -> Power
Generic)


floatingFactor :: Power -> Double
floatingFactor :: Power -> Double
floatingFactor Power
Ki = Double
1.0
floatingFactor Power
Mi = Double
1024.0
floatingFactor Power
Gi = Double
1024.0 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2
floatingFactor Power
Ti = Double
1024.0 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
3


powerReader :: Text -> Either String (Power, Text)
powerReader :: Text -> Either String (Power, Text)
powerReader Text
x =
  let (Text
want, Text
extra) = Int -> Text -> (Text, Text)
Text.splitAt Int
3 (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.stripStart Text
x
      go :: Text -> Either String (Power, Text)
go Text
"Ki" = (Power, Text) -> Either String (Power, Text)
forall a b. b -> Either a b
Right (Power
Ki, Text
extra)
      go Text
"Mi" = (Power, Text) -> Either String (Power, Text)
forall a b. b -> Either a b
Right (Power
Mi, Text
extra)
      go Text
"Gi" = (Power, Text) -> Either String (Power, Text)
forall a b. b -> Either a b
Right (Power
Gi, Text
extra)
      go Text
"Ti" = (Power, Text) -> Either String (Power, Text)
forall a b. b -> Either a b
Right (Power
Ti, Text
extra)
      go Text
_other = String -> Either String (Power, Text)
forall a b. a -> Either a b
Left String
"invalid Power"
   in Text -> Either String (Power, Text)
go (Text -> Either String (Power, Text))
-> Text -> Either String (Power, Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.take Int
2 Text
want


-- | Represents an amount of memory
data Mem = Mem !Power !Deci
  deriving (Mem -> Mem -> Bool
(Mem -> Mem -> Bool) -> (Mem -> Mem -> Bool) -> Eq Mem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mem -> Mem -> Bool
== :: Mem -> Mem -> Bool
$c/= :: Mem -> Mem -> Bool
/= :: Mem -> Mem -> Bool
Eq, Int -> Mem -> ShowS
[Mem] -> ShowS
Mem -> String
(Int -> Mem -> ShowS)
-> (Mem -> String) -> ([Mem] -> ShowS) -> Show Mem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mem -> ShowS
showsPrec :: Int -> Mem -> ShowS
$cshow :: Mem -> String
show :: Mem -> String
$cshowList :: [Mem] -> ShowS
showList :: [Mem] -> ShowS
Show, Eq Mem
Eq Mem =>
(Mem -> Mem -> Ordering)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Mem)
-> (Mem -> Mem -> Mem)
-> Ord Mem
Mem -> Mem -> Bool
Mem -> Mem -> Ordering
Mem -> Mem -> Mem
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 :: Mem -> Mem -> Ordering
compare :: Mem -> Mem -> Ordering
$c< :: Mem -> Mem -> Bool
< :: Mem -> Mem -> Bool
$c<= :: Mem -> Mem -> Bool
<= :: Mem -> Mem -> Bool
$c> :: Mem -> Mem -> Bool
> :: Mem -> Mem -> Bool
$c>= :: Mem -> Mem -> Bool
>= :: Mem -> Mem -> Bool
$cmax :: Mem -> Mem -> Mem
max :: Mem -> Mem -> Mem
$cmin :: Mem -> Mem -> Mem
min :: Mem -> Mem -> Mem
Ord, (forall x. Mem -> Rep Mem x)
-> (forall x. Rep Mem x -> Mem) -> Generic Mem
forall x. Rep Mem x -> Mem
forall x. Mem -> Rep Mem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mem -> Rep Mem x
from :: forall x. Mem -> Rep Mem x
$cto :: forall x. Rep Mem x -> Mem
to :: forall x. Rep Mem x -> Mem
Generic)


asFloat :: Mem -> Double
asFloat :: Mem -> Double
asFloat (Mem Power
pow Deci
x) = Deci -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Deci
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Power -> Double
floatingFactor Power
pow


memReader :: Text -> Either String (Mem, Text)
memReader :: Reader Mem
memReader Text
x = do
  (Deci
num, Text
rest) <- Reader Deci
forall a. Fractional a => Reader a
rational (Text -> Text
Text.stripStart Text
x)
  (Power
power, Text
extra) <- Text -> Either String (Power, Text)
powerReader Text
rest
  (Mem, Text) -> Either String (Mem, Text)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Power -> Deci -> Mem
Mem Power
power Deci
num, Text
extra)