{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

module Cardano.RTView.CLI
    ( RTViewParams (..)
    , defaultRTViewParams
    , defaultRTVConfig
    , defaultRTVStatic
    , defaultRTVPort
    , defaultRTVNodeInfoLife
    , defaultRTVBlockchainInfoLife
    , defaultRTVResourcesInfoLife
    , defaultRTVRTSInfoLife
    , parseRTViewParams
    ) where

import           Cardano.Prelude hiding (option)
import           Prelude (String)

import           Data.Yaml (FromJSON, ToJSON)
import           GHC.Generics (Generic)

import           Options.Applicative (HasCompleter, HasMetavar, HasName, HasValue, Mod, Parser,
                                      auto, bashCompleter, completer, help, long, metavar, option,
                                      showDefault, strOption, value)

-- | Type for CLI parameters required for the service.
data RTViewParams
  = RTViewParams
      { RTViewParams -> FilePath
rtvConfig             :: !FilePath
      , RTViewParams -> FilePath
rtvStatic             :: !FilePath
      , RTViewParams -> Int
rtvPort               :: !Int
      , RTViewParams -> Word64
rtvNodeInfoLife       :: !Word64
      , RTViewParams -> Word64
rtvBlockchainInfoLife :: !Word64
      , RTViewParams -> Word64
rtvResourcesInfoLife  :: !Word64
      , RTViewParams -> Word64
rtvRTSInfoLife        :: !Word64
      } deriving ((forall x. RTViewParams -> Rep RTViewParams x)
-> (forall x. Rep RTViewParams x -> RTViewParams)
-> Generic RTViewParams
forall x. Rep RTViewParams x -> RTViewParams
forall x. RTViewParams -> Rep RTViewParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RTViewParams x -> RTViewParams
$cfrom :: forall x. RTViewParams -> Rep RTViewParams x
Generic, Value -> Parser [RTViewParams]
Value -> Parser RTViewParams
(Value -> Parser RTViewParams)
-> (Value -> Parser [RTViewParams]) -> FromJSON RTViewParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RTViewParams]
$cparseJSONList :: Value -> Parser [RTViewParams]
parseJSON :: Value -> Parser RTViewParams
$cparseJSON :: Value -> Parser RTViewParams
FromJSON, [RTViewParams] -> Encoding
[RTViewParams] -> Value
RTViewParams -> Encoding
RTViewParams -> Value
(RTViewParams -> Value)
-> (RTViewParams -> Encoding)
-> ([RTViewParams] -> Value)
-> ([RTViewParams] -> Encoding)
-> ToJSON RTViewParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RTViewParams] -> Encoding
$ctoEncodingList :: [RTViewParams] -> Encoding
toJSONList :: [RTViewParams] -> Value
$ctoJSONList :: [RTViewParams] -> Value
toEncoding :: RTViewParams -> Encoding
$ctoEncoding :: RTViewParams -> Encoding
toJSON :: RTViewParams -> Value
$ctoJSON :: RTViewParams -> Value
ToJSON)

defaultRTViewParams :: RTViewParams
defaultRTViewParams :: RTViewParams
defaultRTViewParams = RTViewParams :: FilePath
-> FilePath
-> Int
-> Word64
-> Word64
-> Word64
-> Word64
-> RTViewParams
RTViewParams
  { rtvConfig :: FilePath
rtvConfig             = FilePath
defaultRTVConfig
  , rtvStatic :: FilePath
rtvStatic             = FilePath
defaultRTVStatic
  , rtvPort :: Int
rtvPort               = Int
defaultRTVPort
  , rtvNodeInfoLife :: Word64
rtvNodeInfoLife       = Word64
defaultRTVNodeInfoLife
  , rtvBlockchainInfoLife :: Word64
rtvBlockchainInfoLife = Word64
defaultRTVBlockchainInfoLife
  , rtvResourcesInfoLife :: Word64
rtvResourcesInfoLife  = Word64
defaultRTVResourcesInfoLife
  , rtvRTSInfoLife :: Word64
rtvRTSInfoLife        = Word64
defaultRTVRTSInfoLife
  }

defaultRTVConfig, defaultRTVStatic :: FilePath
defaultRTVConfig :: FilePath
defaultRTVConfig = FilePath
""
defaultRTVStatic :: FilePath
defaultRTVStatic = FilePath
"static"

defaultRTVPort :: Int
defaultRTVPort :: Int
defaultRTVPort = Int
8024

defaultRTVNodeInfoLife
  , defaultRTVBlockchainInfoLife
  , defaultRTVResourcesInfoLife
  , defaultRTVRTSInfoLife :: Word64
defaultRTVNodeInfoLife :: Word64
defaultRTVNodeInfoLife       = Int -> Word64
secToNanosec Int
5
defaultRTVBlockchainInfoLife :: Word64
defaultRTVBlockchainInfoLife = Int -> Word64
secToNanosec Int
35
defaultRTVResourcesInfoLife :: Word64
defaultRTVResourcesInfoLife  = Int -> Word64
secToNanosec Int
35
defaultRTVRTSInfoLife :: Word64
defaultRTVRTSInfoLife        = Int -> Word64
secToNanosec Int
45

secToNanosec :: Int -> Word64
secToNanosec :: Int -> Word64
secToNanosec Int
s = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000000

parseRTViewParams :: Parser RTViewParams
parseRTViewParams :: Parser RTViewParams
parseRTViewParams =
  FilePath
-> FilePath
-> Int
-> Word64
-> Word64
-> Word64
-> Word64
-> RTViewParams
RTViewParams
    (FilePath
 -> FilePath
 -> Int
 -> Word64
 -> Word64
 -> Word64
 -> Word64
 -> RTViewParams)
-> Parser FilePath
-> Parser
     (FilePath
      -> Int -> Word64 -> Word64 -> Word64 -> Word64 -> RTViewParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FilePath -> FilePath -> FilePath -> Parser FilePath
parseFilePath
          FilePath
"config"
          FilePath
"file"
          FilePath
"Configuration file for RTView service. If not provided, interactive dialog will be started."
          FilePath
defaultRTVConfig
    Parser
  (FilePath
   -> Int -> Word64 -> Word64 -> Word64 -> Word64 -> RTViewParams)
-> Parser FilePath
-> Parser
     (Int -> Word64 -> Word64 -> Word64 -> Word64 -> RTViewParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> FilePath -> FilePath -> Parser FilePath
parseFilePath
          FilePath
"static"
          FilePath
"directory"
          FilePath
"Directory with static content"
          FilePath
defaultRTVStatic
    Parser
  (Int -> Word64 -> Word64 -> Word64 -> Word64 -> RTViewParams)
-> Parser Int
-> Parser (Word64 -> Word64 -> Word64 -> Word64 -> RTViewParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Int -> Parser Int
parsePort
          FilePath
"port"
          FilePath
"The port number"
          Int
defaultRTVPort
    Parser (Word64 -> Word64 -> Word64 -> Word64 -> RTViewParams)
-> Parser Word64
-> Parser (Word64 -> Word64 -> Word64 -> RTViewParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Word64 -> Parser Word64
parseDiffTime
          FilePath
"node-info-life"
          FilePath
"Lifetime of node info"
          Word64
defaultRTVNodeInfoLife
    Parser (Word64 -> Word64 -> Word64 -> RTViewParams)
-> Parser Word64 -> Parser (Word64 -> Word64 -> RTViewParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Word64 -> Parser Word64
parseDiffTime
          FilePath
"blockchain-info-life"
          FilePath
"Lifetime of blockchain info"
          Word64
defaultRTVBlockchainInfoLife
    Parser (Word64 -> Word64 -> RTViewParams)
-> Parser Word64 -> Parser (Word64 -> RTViewParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Word64 -> Parser Word64
parseDiffTime
          FilePath
"resources-info-life"
          FilePath
"Lifetime of resources info"
          Word64
defaultRTVResourcesInfoLife
    Parser (Word64 -> RTViewParams)
-> Parser Word64 -> Parser RTViewParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Word64 -> Parser Word64
parseDiffTime
          FilePath
"rts-info-life"
          FilePath
"Lifetime of GHC RTS info"
          Word64
defaultRTVRTSInfoLife

-- Aux parsers

parseFilePath
  :: String
  -> String
  -> String
  -> FilePath
  -> Parser FilePath
parseFilePath :: FilePath -> FilePath -> FilePath -> FilePath -> Parser FilePath
parseFilePath FilePath
optname FilePath
completion FilePath
desc FilePath
defaultPath =
  let flags :: (HasCompleter f, HasMetavar f, HasName f, HasValue f)
            => Mod f FilePath
      flags :: Mod f FilePath
flags = FilePath -> Mod f FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
optname
           Mod f FilePath -> Mod f FilePath -> Mod f FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod f FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILEPATH"
           Mod f FilePath -> Mod f FilePath -> Mod f FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod f FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
desc
           Mod f FilePath -> Mod f FilePath -> Mod f FilePath
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod f FilePath
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (FilePath -> Completer
bashCompleter FilePath
completion)
           Mod f FilePath -> Mod f FilePath -> Mod f FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod f FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
defaultPath
  in Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
defaultPath
                   then Mod OptionFields FilePath
forall (f :: * -> *).
(HasCompleter f, HasMetavar f, HasName f, HasValue f) =>
Mod f FilePath
flags
                   else Mod OptionFields FilePath
forall (f :: * -> *).
(HasCompleter f, HasMetavar f, HasName f, HasValue f) =>
Mod f FilePath
flags Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault

parsePort
  :: String
  -> String
  -> Int
  -> Parser Int
parsePort :: FilePath -> FilePath -> Int -> Parser Int
parsePort FilePath
optname FilePath
desc Int
defaultPort =
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (
       FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
optname
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PORT"
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
desc
    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
value Int
defaultPort
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault
  )

parseDiffTime
  :: String
  -> String
  -> Word64
  -> Parser Word64
parseDiffTime :: FilePath -> FilePath -> Word64 -> Parser Word64
parseDiffTime FilePath
optname FilePath
desc Word64
defaultTime =
  ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Int -> Word64
secToNanosec (Int -> Word64) -> ReadM Int -> ReadM Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int
forall a. Read a => ReadM a
auto) (
       FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
optname
    Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIFFTIME"
    Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
desc
    Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> Word64 -> Mod OptionFields Word64
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Word64
defaultTime
    Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Word64
forall a (f :: * -> *). Show a => Mod f a
showDefault
  )