{-# LANGUAGE OverloadedStrings #-}

module Network.IRC.Bot.Options
  ( execBotOptsParser
  , parseBotConf
  ) where

import Data.ByteString            (ByteString)

import qualified Data.ByteString.Char8
import qualified Data.Set

import Options.Applicative
import Data.Semigroup ((<>))

import Network.IRC.Bot.Core       (BotConf(..), User(..))
import Network.IRC.Bot.Log        (Logger, LogLevel(..), stdoutLogger)

execBotOptsParser :: Parser extra -> IO (BotConf, extra)
execBotOptsParser :: Parser extra -> IO (BotConf, extra)
execBotOptsParser Parser extra
parseExtra = ParserInfo (BotConf, extra) -> IO (BotConf, extra)
forall a. ParserInfo a -> IO a
execParser
  (ParserInfo (BotConf, extra) -> IO (BotConf, extra))
-> ParserInfo (BotConf, extra) -> IO (BotConf, extra)
forall a b. (a -> b) -> a -> b
$ Parser (BotConf, extra)
-> InfoMod (BotConf, extra) -> ParserInfo (BotConf, extra)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (((,) (BotConf -> extra -> (BotConf, extra))
-> Parser BotConf -> Parser (extra -> (BotConf, extra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BotConf
parseBotConf Parser (extra -> (BotConf, extra))
-> Parser extra -> Parser (BotConf, extra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser extra
parseExtra) Parser (BotConf, extra)
-> Parser ((BotConf, extra) -> (BotConf, extra))
-> Parser (BotConf, extra)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser ((BotConf, extra) -> (BotConf, extra))
forall a. Parser (a -> a)
helper)
    ( InfoMod (BotConf, extra)
forall a. InfoMod a
fullDesc
    InfoMod (BotConf, extra)
-> InfoMod (BotConf, extra) -> InfoMod (BotConf, extra)
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (BotConf, extra)
forall a. String -> InfoMod a
progDesc String
"ircbot"
    InfoMod (BotConf, extra)
-> InfoMod (BotConf, extra) -> InfoMod (BotConf, extra)
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (BotConf, extra)
forall a. String -> InfoMod a
header String
"ircbot - Haskell IRC bot" )

parseBotConf :: Parser BotConf
parseBotConf :: Parser BotConf
parseBotConf = Maybe (Chan Message -> IO ())
-> Logger
-> String
-> PortNumber
-> ByteString
-> String
-> User
-> Set ByteString
-> Maybe (Int, Int)
-> BotConf
BotConf
  (Maybe (Chan Message -> IO ())
 -> Logger
 -> String
 -> PortNumber
 -> ByteString
 -> String
 -> User
 -> Set ByteString
 -> Maybe (Int, Int)
 -> BotConf)
-> Parser (Maybe (Chan Message -> IO ()))
-> Parser
     (Logger
      -> String
      -> PortNumber
      -> ByteString
      -> String
      -> User
      -> Set ByteString
      -> Maybe (Int, Int)
      -> BotConf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Chan Message -> IO ())
-> Parser (Maybe (Chan Message -> IO ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Chan Message -> IO ())
forall a. Maybe a
Nothing
  Parser
  (Logger
   -> String
   -> PortNumber
   -> ByteString
   -> String
   -> User
   -> Set ByteString
   -> Maybe (Int, Int)
   -> BotConf)
-> Parser Logger
-> Parser
     (String
      -> PortNumber
      -> ByteString
      -> String
      -> User
      -> Set ByteString
      -> Maybe (Int, Int)
      -> BotConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Logger
parseLogger
  Parser
  (String
   -> PortNumber
   -> ByteString
   -> String
   -> User
   -> Set ByteString
   -> Maybe (Int, Int)
   -> BotConf)
-> Parser String
-> Parser
     (PortNumber
      -> ByteString
      -> String
      -> User
      -> Set ByteString
      -> Maybe (Int, Int)
      -> BotConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"server" 
     Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
     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
metavar String
"HOST_OR_IP"
     Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"localhost"
     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
help String
"IRC server to connect to")
  Parser
  (PortNumber
   -> ByteString
   -> String
   -> User
   -> Set ByteString
   -> Maybe (Int, Int)
   -> BotConf)
-> Parser PortNumber
-> Parser
     (ByteString
      -> String -> User -> Set ByteString -> Maybe (Int, Int) -> BotConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM PortNumber
-> Mod OptionFields PortNumber -> Parser PortNumber
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM PortNumber
forall a. Read a => ReadM a
auto
    (String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port"
     Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
     Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT"
     Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> PortNumber -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value PortNumber
6667
     Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. String -> Mod f a
help String
"Port of the IRC server to use")
  Parser
  (ByteString
   -> String -> User -> Set ByteString -> Maybe (Int, Int) -> BotConf)
-> Parser ByteString
-> Parser
     (String -> User -> Set ByteString -> Maybe (Int, Int) -> BotConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields ByteString -> Parser ByteString
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields ByteString
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"nick"
     Mod OptionFields ByteString
-> Mod OptionFields ByteString -> Mod OptionFields ByteString
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields ByteString
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n'
     Mod OptionFields ByteString
-> Mod OptionFields ByteString -> Mod OptionFields ByteString
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ByteString
forall (f :: * -> *) a. String -> Mod f a
help String
"IRC nick")
  Parser
  (String -> User -> Set ByteString -> Maybe (Int, Int) -> BotConf)
-> Parser String
-> Parser (User -> Set ByteString -> Maybe (Int, Int) -> BotConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cmd-prefix"
     Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c'
     Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"#"
     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
help String
"Bot command prefix")
  Parser (User -> Set ByteString -> Maybe (Int, Int) -> BotConf)
-> Parser User
-> Parser (Set ByteString -> Maybe (Int, Int) -> BotConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser User
parseUser
  Parser (Set ByteString -> Maybe (Int, Int) -> BotConf)
-> Parser (Set ByteString) -> Parser (Maybe (Int, Int) -> BotConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
Data.Set.fromList ([ByteString] -> Set ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> Set ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
coercePrefixes ([ByteString] -> Set ByteString)
-> Parser [ByteString] -> Parser (Set ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     Parser ByteString -> Parser [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ReadM ByteString
-> Mod ArgumentFields ByteString -> Parser ByteString
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM ByteString
forall s. IsString s => ReadM s
str
             (String -> Mod ArgumentFields ByteString
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"CHANNEL [CHANNEL]"
             Mod ArgumentFields ByteString
-> Mod ArgumentFields ByteString -> Mod ArgumentFields ByteString
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields ByteString
forall (f :: * -> *) a. String -> Mod f a
help String
"IRC channels to join to, channel prefix # not required")
            ))
  Parser (Maybe (Int, Int) -> BotConf)
-> Parser (Maybe (Int, Int)) -> Parser BotConf
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Int, Int))
parseLimits

-- | Prefix channel name with '#' if needed
coercePrefixes :: ByteString -> ByteString
coercePrefixes :: ByteString -> ByteString
coercePrefixes ByteString
x | ByteString
"#" ByteString -> ByteString -> Bool
`Data.ByteString.Char8.isPrefixOf` ByteString
x = ByteString
x
coercePrefixes ByteString
x | Bool
otherwise = Char -> ByteString -> ByteString
Data.ByteString.Char8.cons Char
'#' ByteString
x

parseLogger :: Parser Logger
parseLogger :: Parser Logger
parseLogger = LogLevel -> Logger
stdoutLogger
  (LogLevel -> Logger) -> Parser LogLevel -> Parser Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogLevel -> LogLevel -> Mod FlagFields LogLevel -> Parser LogLevel
forall a. a -> a -> Mod FlagFields a -> Parser a
flag LogLevel
Normal LogLevel
Debug
    (String -> Mod FlagFields LogLevel
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"debug"
     Mod FlagFields LogLevel
-> Mod FlagFields LogLevel -> Mod FlagFields LogLevel
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields LogLevel
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
     Mod FlagFields LogLevel
-> Mod FlagFields LogLevel -> Mod FlagFields LogLevel
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields LogLevel
forall (f :: * -> *) a. String -> Mod f a
help String
"Enable debug output")

parseUser :: Parser User
parseUser :: Parser User
parseUser = ByteString -> String -> String -> ByteString -> User
User
  (ByteString -> String -> String -> ByteString -> User)
-> Parser ByteString
-> Parser (String -> String -> ByteString -> User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields ByteString -> Parser ByteString
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields ByteString
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"username"
     Mod OptionFields ByteString
-> Mod OptionFields ByteString -> Mod OptionFields ByteString
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ByteString
forall (f :: * -> *) a. String -> Mod f a
help String
"Ident username")
  Parser (String -> String -> ByteString -> User)
-> Parser String -> Parser (String -> ByteString -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hostname"
     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
help String
"Hostname of the client system")
  Parser (String -> ByteString -> User)
-> Parser String -> Parser (ByteString -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"."
  Parser (ByteString -> User) -> Parser ByteString -> Parser User
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields ByteString -> Parser ByteString
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (String -> Mod OptionFields ByteString
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"realname"
     Mod OptionFields ByteString
-> Mod OptionFields ByteString -> Mod OptionFields ByteString
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ByteString
forall (f :: * -> *) a. String -> Mod f a
help String
"Clients real name")

parseLimits :: Parser (Maybe (Int, Int))
parseLimits :: Parser (Maybe (Int, Int))
parseLimits = Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (Int, Int) -> Parser (Maybe (Int, Int)))
-> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ (,)
  (Int -> Int -> (Int, Int))
-> Parser Int -> Parser (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
    (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"burst-length"
     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
metavar String
"BURST"
     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
2
     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
help String
"Rate limit after a BURST limit of messages is reached")
  Parser (Int -> (Int, Int)) -> Parser Int -> Parser (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
    (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"delay-ms"
     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
metavar String
"MS"
     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
2
     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
help String
"Delay in microseconds for rate limiting")