-- |@optparse-applicative@ parsers for the Ribosome CLI.
module Ribosome.Cli where

import Exon (exon)
import Options.Applicative (
  Parser,
  customExecParser,
  fullDesc,
  header,
  helper,
  info,
  long,
  option,
  prefs,
  showHelpOnEmpty,
  showHelpOnError,
  )
import Path (Abs, Dir, Path)
import Path.IO (getCurrentDir)

import Ribosome.Host.Optparse (filePathOption, severityOption)
import Ribosome.Data.CliConfig (CliConfig (CliConfig), CliLogConfig (CliLogConfig))
import Ribosome.Data.PluginName (PluginName (PluginName))
import Ribosome.Host.Data.HostConfig (HostConfig (HostConfig), LogConfig (LogConfig))

-- |Parse the options related to logging.
logParser ::
  Path Abs Dir ->
  Parser CliLogConfig
logParser :: Path Abs Dir -> Parser CliLogConfig
logParser Path Abs Dir
cwd = do
  Maybe (Path Abs File)
logFile <- Parser (Path Abs File) -> Parser (Maybe (Path Abs File))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM (Path Abs File)
-> Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Path Abs Dir -> ReadM (Path Abs File)
filePathOption Path Abs Dir
cwd) (String -> Mod OptionFields (Path Abs File)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-file"))
  Maybe Severity
levelEcho <- Parser Severity -> Parser (Maybe Severity)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Severity -> Mod OptionFields Severity -> Parser Severity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Severity
severityOption (String -> Mod OptionFields Severity
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-level-echo"))
  Maybe Severity
levelStderr <- Parser Severity -> Parser (Maybe Severity)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Severity -> Mod OptionFields Severity -> Parser Severity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Severity
severityOption (String -> Mod OptionFields Severity
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-level-stderr"))
  Maybe Severity
levelFile <- Parser Severity -> Parser (Maybe Severity)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Severity -> Mod OptionFields Severity -> Parser Severity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Severity
severityOption (String -> Mod OptionFields Severity
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-level-file"))
  pure (Maybe (Path Abs File)
-> Maybe Severity
-> Maybe Severity
-> Maybe Severity
-> CliLogConfig
CliLogConfig Maybe (Path Abs File)
logFile Maybe Severity
levelEcho Maybe Severity
levelStderr Maybe Severity
levelFile)

-- |Parse the host config as well as the arbitrary user defined config.
confParser ::
  Path Abs Dir ->
  Parser c ->
  Parser (CliConfig, c)
confParser :: forall c. Path Abs Dir -> Parser c -> Parser (CliConfig, c)
confParser Path Abs Dir
cwd Parser c
customParser = do
  CliConfig
cli <- CliLogConfig -> CliConfig
CliConfig (CliLogConfig -> CliConfig)
-> Parser CliLogConfig -> Parser CliConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> Parser CliLogConfig
logParser Path Abs Dir
cwd
  c
custom <- Parser c
customParser
  pure (CliConfig
cli, c
custom)

-- |Parse the host config as well as the arbitrary user defined config, in 'IO'.
parseCli ::
  PluginName ->
  Parser c ->
  IO (CliConfig, c)
parseCli :: forall c. PluginName -> Parser c -> IO (CliConfig, c)
parseCli (PluginName Text
name) Parser c
customParser = do
  Path Abs Dir
cwd <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
  ParserPrefs -> ParserInfo (CliConfig, c) -> IO (CliConfig, c)
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
parserPrefs (Parser (CliConfig, c)
-> InfoMod (CliConfig, c) -> ParserInfo (CliConfig, c)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ((CliConfig, c) -> (CliConfig, c))
forall a. Parser (a -> a)
helper Parser ((CliConfig, c) -> (CliConfig, c))
-> Parser (CliConfig, c) -> Parser (CliConfig, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Path Abs Dir -> Parser c -> Parser (CliConfig, c)
forall c. Path Abs Dir -> Parser c -> Parser (CliConfig, c)
confParser Path Abs Dir
cwd Parser c
customParser) InfoMod (CliConfig, c)
desc)
  where
    parserPrefs :: ParserPrefs
parserPrefs =
      PrefsMod -> ParserPrefs
prefs (PrefsMod
showHelpOnEmpty PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnError)
    desc :: InfoMod (CliConfig, c)
desc =
      InfoMod (CliConfig, c)
forall a. InfoMod a
fullDesc InfoMod (CliConfig, c)
-> InfoMod (CliConfig, c) -> InfoMod (CliConfig, c)
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (CliConfig, c)
forall a. String -> InfoMod a
header [exon|#{toString name} is a Neovim plugin.|]

-- |Parse the CLI options for a plugin config and update a default 'HostConfig' with the CLI options.
withDefault :: HostConfig -> CliConfig -> HostConfig
withDefault :: HostConfig -> CliConfig -> HostConfig
withDefault (HostConfig LogConfig
defLog) CliConfig
cliConfig =
  LogConfig -> HostConfig
HostConfig LogConfig
log
  where
    CliConfig (CliLogConfig Maybe (Path Abs File)
file Maybe Severity
levelEcho Maybe Severity
levelStderr Maybe Severity
levelFile) =
      CliConfig
cliConfig
    LogConfig Maybe (Path Abs File)
defFile Severity
defLevelEcho Severity
defLevelStderr Severity
defLevelFile Bool
conc =
      LogConfig
defLog
    log :: LogConfig
log =
      Maybe (Path Abs File)
-> Severity -> Severity -> Severity -> Bool -> LogConfig
LogConfig (Maybe (Path Abs File)
file Maybe (Path Abs File)
-> Maybe (Path Abs File) -> Maybe (Path Abs File)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Path Abs File)
defFile) (Severity -> Maybe Severity -> Severity
forall a. a -> Maybe a -> a
fromMaybe Severity
defLevelEcho Maybe Severity
levelEcho) (Severity -> Maybe Severity -> Severity
forall a. a -> Maybe a -> a
fromMaybe Severity
defLevelStderr Maybe Severity
levelStderr)
      (Severity -> Maybe Severity -> Severity
forall a. a -> Maybe a -> a
fromMaybe Severity
defLevelFile Maybe Severity
levelFile) Bool
conc

-- |Parse the CLI options for a plugin config and pass an updated default 'HostConfig' to a callback.
withCli ::
  PluginName ->
  HostConfig ->
  Parser c ->
  (HostConfig -> c -> IO a) ->
  IO a
withCli :: forall c a.
PluginName
-> HostConfig -> Parser c -> (HostConfig -> c -> IO a) -> IO a
withCli PluginName
name HostConfig
defaultConf Parser c
customParser HostConfig -> c -> IO a
f = do
  (CliConfig
cliConfig, c
custom) <- PluginName -> Parser c -> IO (CliConfig, c)
forall c. PluginName -> Parser c -> IO (CliConfig, c)
parseCli PluginName
name Parser c
customParser
  HostConfig -> c -> IO a
f (HostConfig -> CliConfig -> HostConfig
withDefault HostConfig
defaultConf CliConfig
cliConfig) c
custom