{-|
Module      : KMonad.Args.Cmd
Description : Parse command-line options into a 'Cmd' for KMonad to execute
Copyright   : (c) David Janssen, 2019
License     : MIT

Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : non-portable (MPTC with FD, FFI to Linux-only c-code)

-}
module KMonad.Args.Cmd
  ( Cmd(..)
  , HasCmd(..)
  , getCmd
  )
where

import KMonad.Prelude

import Options.Applicative


--------------------------------------------------------------------------------
-- $cmd
--
-- The different things KMonad can be instructed to do.

-- | Record describing the instruction to KMonad
data Cmd = Cmd
  { Cmd -> FilePath
_cfgFile :: FilePath -- ^ Which file to read the config from
  , Cmd -> Bool
_dryRun  :: Bool     -- ^ Flag to indicate we are only test-parsing
  , Cmd -> LogLevel
_logLvl  :: LogLevel -- ^ Level of logging to use
  }
  deriving Int -> Cmd -> ShowS
[Cmd] -> ShowS
Cmd -> FilePath
(Int -> Cmd -> ShowS)
-> (Cmd -> FilePath) -> ([Cmd] -> ShowS) -> Show Cmd
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Cmd] -> ShowS
$cshowList :: [Cmd] -> ShowS
show :: Cmd -> FilePath
$cshow :: Cmd -> FilePath
showsPrec :: Int -> Cmd -> ShowS
$cshowsPrec :: Int -> Cmd -> ShowS
Show
makeClassy ''Cmd

-- | Parse 'Cmd' from the evocation of this program
getCmd :: IO Cmd
getCmd :: IO Cmd
getCmd = ParserPrefs -> ParserInfo Cmd -> IO Cmd
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser (PrefsMod -> ParserPrefs
prefs PrefsMod
showHelpOnEmpty) (ParserInfo Cmd -> IO Cmd) -> ParserInfo Cmd -> IO Cmd
forall a b. (a -> b) -> a -> b
$ Parser Cmd -> InfoMod Cmd -> ParserInfo Cmd
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Cmd
cmdP Parser Cmd -> Parser (Cmd -> Cmd) -> Parser Cmd
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Cmd -> Cmd)
forall a. Parser (a -> a)
helper)
  (  InfoMod Cmd
forall a. InfoMod a
fullDesc
  InfoMod Cmd -> InfoMod Cmd -> InfoMod Cmd
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Cmd
forall a. FilePath -> InfoMod a
progDesc "Start KMonad"
  InfoMod Cmd -> InfoMod Cmd -> InfoMod Cmd
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Cmd
forall a. FilePath -> InfoMod a
header   "kmonad - an onion of buttons."
  )


--------------------------------------------------------------------------------
-- $prs
--
-- The different command-line parsers

-- | Parse the full command
cmdP :: Parser Cmd
cmdP :: Parser Cmd
cmdP = FilePath -> Bool -> LogLevel -> Cmd
Cmd (FilePath -> Bool -> LogLevel -> Cmd)
-> Parser FilePath -> Parser (Bool -> LogLevel -> Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
fileP Parser (Bool -> LogLevel -> Cmd)
-> Parser Bool -> Parser (LogLevel -> Cmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
dryrunP Parser (LogLevel -> Cmd) -> Parser LogLevel -> Parser Cmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LogLevel
levelP

-- | Parse a filename that points us at the config-file
fileP :: Parser FilePath
fileP :: Parser FilePath
fileP = Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
  (  FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "FILE"
  Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help    "The configuration file")

-- | Parse a flag that allows us to switch to parse-only mode
dryrunP :: Parser Bool
dryrunP :: Parser Bool
dryrunP = Mod FlagFields Bool -> Parser Bool
switch
  (  FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    "dry-run"
  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short   'd'
  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help    "If used, do not start KMonad, only try parsing the config file"
  )

-- | Parse the log-level as either a level option or a verbose flag
levelP :: Parser LogLevel
levelP :: Parser LogLevel
levelP = ReadM LogLevel -> Mod OptionFields LogLevel -> Parser LogLevel
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM LogLevel
f
  (  FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    "log-level"
  Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short   'l'
  Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "Log level"
  Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> LogLevel -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value   LogLevel
LevelWarn
  Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. FilePath -> Mod f a
help    "How much info to print out (debug, info, warn, error)" )
  where
    f :: ReadM LogLevel
f = (FilePath -> Maybe LogLevel) -> ReadM LogLevel
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader ((FilePath -> Maybe LogLevel) -> ReadM LogLevel)
-> (FilePath -> Maybe LogLevel) -> ReadM LogLevel
forall a b. (a -> b) -> a -> b
$ (FilePath -> [(FilePath, LogLevel)] -> Maybe LogLevel)
-> [(FilePath, LogLevel)] -> FilePath -> Maybe LogLevel
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [(FilePath, LogLevel)] -> Maybe LogLevel
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [ ("debug", LogLevel
LevelDebug), ("warn", LogLevel
LevelWarn)
                                  , ("info",  LogLevel
LevelInfo),  ("error", LogLevel
LevelError) ]