{- |
Module      : GHC.Eventlog.Live.Options
Description : Command-line option parsers for eventlog machines.
Stability   : experimental
Portability : portable
-}
module GHC.Eventlog.Live.Options (
  EventlogSource (..),
  eventlogSourceParser,
  eventlogSocketTimeoutParser,
  eventlogSocketTimeoutExponentParser,
  heapProfBreakdownParser,
  eventlogLogFileParser,
  batchIntervalParser,
  verbosityParser,
) where

import Control.Applicative (asum)
import Data.Char (toLower)
import GHC.Eventlog.Live.Machine.Analysis.Heap (heapProfBreakdownEitherReader)
import GHC.Eventlog.Live.Verbosity (Verbosity, verbosityDebug, verbosityError, verbosityInfo, verbosityQuiet, verbosityWarning)
import GHC.RTS.Events (HeapProfBreakdown (..))
import Options.Applicative qualified as O
import Text.Read (readEither)

--------------------------------------------------------------------------------
-- Eventlog Socket

{- |
The type of eventlog sockets.
-}
data EventlogSource
  = EventlogStdin
  | EventlogFile FilePath
  | EventlogSocketUnix FilePath

{- |
Parser for the eventlog socket.
-}
eventlogSourceParser :: O.Parser EventlogSource
eventlogSourceParser :: Parser EventlogSource
eventlogSourceParser =
  [Parser EventlogSource] -> Parser EventlogSource
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Parser EventlogSource
stdinParser
    , Parser EventlogSource
fileParser
    , Parser EventlogSource
socketUnixParser
    ]
 where
  stdinParser :: Parser EventlogSource
stdinParser =
    EventlogSource
EventlogStdin
      EventlogSource -> Parser () -> Parser EventlogSource
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
O.flag'
        ()
        ( String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"eventlog-stdin"
            Mod FlagFields () -> Mod FlagFields () -> Mod FlagFields ()
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Read the eventlog from stdin."
        )
  fileParser :: Parser EventlogSource
fileParser =
    String -> EventlogSource
EventlogFile
      (String -> EventlogSource)
-> Parser String -> Parser EventlogSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption
        ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"eventlog-file"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"FILE"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Read the eventlog from a file."
        )
  socketUnixParser :: Parser EventlogSource
socketUnixParser =
    String -> EventlogSource
EventlogSocketUnix
      (String -> EventlogSource)
-> Parser String -> Parser EventlogSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption
        ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"eventlog-socket"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"SOCKET"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Read the eventlog from a Unix socket."
        )

{- |
Parser for the intial timeout for exponential backoff.
-}
eventlogSocketTimeoutParser :: O.Parser Double
eventlogSocketTimeoutParser :: Parser Double
eventlogSocketTimeoutParser =
  ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option
    ReadM Double
forall a. Read a => ReadM a
O.auto
    ( String -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"eventlog-socket-timeout"
        Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"NUM"
        Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Eventlog socket connection retry timeout in microseconds."
        Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value Double
1
    )

{- |
Parser for the exponent for exponential backoff.
-}
eventlogSocketTimeoutExponentParser :: O.Parser Double
eventlogSocketTimeoutExponentParser :: Parser Double
eventlogSocketTimeoutExponentParser =
  ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option
    ReadM Double
forall a. Read a => ReadM a
O.auto
    ( String -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"eventlog-socket-exponent"
        Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"NUM"
        Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Eventlog socket connection retry timeout exponent."
        Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value Double
1
    )

--------------------------------------------------------------------------------
-- Heap Profile Breakdown

{- |
Parser for the heap profile breakdown.
-}
heapProfBreakdownParser :: O.Parser HeapProfBreakdown
heapProfBreakdownParser :: Parser HeapProfBreakdown
heapProfBreakdownParser =
  ReadM HeapProfBreakdown
-> Mod OptionFields HeapProfBreakdown -> Parser HeapProfBreakdown
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option
    ((String -> Either String HeapProfBreakdown)
-> ReadM HeapProfBreakdown
forall a. (String -> Either String a) -> ReadM a
O.eitherReader String -> Either String HeapProfBreakdown
heapProfBreakdownEitherReader)
    ( Char -> Mod OptionFields HeapProfBreakdown
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'h'
        Mod OptionFields HeapProfBreakdown
-> Mod OptionFields HeapProfBreakdown
-> Mod OptionFields HeapProfBreakdown
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HeapProfBreakdown
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"Tcmdyrbi"
        Mod OptionFields HeapProfBreakdown
-> Mod OptionFields HeapProfBreakdown
-> Mod OptionFields HeapProfBreakdown
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HeapProfBreakdown
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Heap profile breakdown."
    )

--------------------------------------------------------------------------------
-- Eventlog Log File

{- |
Parser for the eventlog log file.
-}
eventlogLogFileParser :: O.Parser FilePath
eventlogLogFileParser :: Parser String
eventlogLogFileParser =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"eventlog-log-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Use file to log binary eventlog data."
    )

--------------------------------------------------------------------------------
-- Batch Interval

{- |
Parser for the batch interval.
-}
batchIntervalParser :: O.Parser Int
batchIntervalParser :: Parser Int
batchIntervalParser =
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option
    ReadM Int
forall a. Read a => ReadM a
O.auto
    ( String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"batch-interval"
        Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"NUM"
        Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Batch interval in milliseconds."
        Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value Int
defaultBatchIntervalMs
    )

{- |
Internal helper.
The default batch interval in milliseconds.
-}
defaultBatchIntervalMs :: Int
defaultBatchIntervalMs :: Int
defaultBatchIntervalMs = Int
1_000

--------------------------------------------------------------------------------
-- Verbosity

{- |
Parser for verbosities.
The default verbosity is `verbosityWarning`.
-}
verbosityParser :: O.Parser Verbosity
verbosityParser :: Parser Verbosity
verbosityParser =
  ReadM Verbosity -> Mod OptionFields Verbosity -> Parser Verbosity
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option
    ((String -> Either String Verbosity) -> ReadM Verbosity
forall a. (String -> Either String a) -> ReadM a
O.eitherReader String -> Either String Verbosity
readEitherVerbosity)
    ( Char -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'v'
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"verbosity"
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"quiet|error|warning|info|debug|0-4"
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. String -> Mod f a
O.help String
"The verbosity threshold for logging."
        Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> Verbosity -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value Verbosity
verbosityWarning
    )

{- |
Internal helper.
Parser for verbosities by number or name.
Case insensitive.
-}
readEitherVerbosity :: String -> Either String Verbosity
readEitherVerbosity :: String -> Either String Verbosity
readEitherVerbosity String
rawVerbosity =
  -- try to parse the verbosity as a number...
  case forall a. Read a => String -> Either String a
readEither @Word String
rawVerbosity of
    -- if the verbosity string is a number, map it to a verbosity...
    Right Word
verbosityThreshold
      | Word
verbosityThreshold Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0 -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityQuiet
      | Word
verbosityThreshold Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
1 -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityError
      | Word
verbosityThreshold Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
2 -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityWarning
      | Word
verbosityThreshold Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
3 -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityInfo
      | Bool
otherwise -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityDebug
    -- otherwise, match it against the literal names of the levels...
    Left String
_parseError -> case Char -> Char
toLower (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
rawVerbosity of
      String
"quiet" -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityQuiet
      String
"error" -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityError
      String
"warning" -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityWarning
      String
"info" -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityInfo
      String
"debug" -> Verbosity -> Either String Verbosity
forall a b. b -> Either a b
Right Verbosity
verbosityDebug
      String
_otherwise -> String -> Either String Verbosity
forall a b. a -> Either a b
Left (String -> Either String Verbosity)
-> String -> Either String Verbosity
forall a b. (a -> b) -> a -> b
$ String
"Could not parse verbosity '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rawVerbosity String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'."