{-# 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 Network.IRC.Bot.Core       (BotConf(..), User(..))
import Network.IRC.Bot.Log        (Logger, LogLevel(..), stdoutLogger)

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

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

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

parseLimits :: Parser (Maybe (Int, Int))
parseLimits :: Parser (Maybe (Int, Int))
parseLimits = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ (,)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
    (forall (f :: * -> *) a. HasName f => HostName -> Mod f a
long HostName
"burst-length"
     forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => HostName -> Mod f a
metavar HostName
"BURST"
     forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
2
     forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HostName -> Mod f a
help HostName
"Rate limit after a BURST limit of messages is reached")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
    (forall (f :: * -> *) a. HasName f => HostName -> Mod f a
long HostName
"delay-ms"
     forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => HostName -> Mod f a
metavar HostName
"MS"
     forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
2
     forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HostName -> Mod f a
help HostName
"Delay in microseconds for rate limiting")