ircbot-simple

Simple.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Simple wrapper on top of simpleBot
-- adding applicative parser
-- and `runBotWithParts` shorthand.
--
-- `runBotWithParts` allows passing
-- initialization function that inits
-- all bot parts and returns them as list.

module Network.IRC.Bot.Simple (
    runBotWithParts
  , parseConf
  ) where

import Data.ByteString            (ByteString)
import Data.Set                   (Set)

import qualified Control.Concurrent
import qualified Control.Monad
import qualified Data.ByteString.Char8
import qualified Data.Set
import qualified Data.List
import qualified System.IO

import Options.Applicative

import Network.IRC.Bot.BotMonad   (BotMonad(..), BotPartT)
import Network.IRC.Bot.Core       (BotConf(..), User(..), nullBotConf, simpleBot)
import Network.IRC.Bot.Log        (Logger, LogLevel(..), nullLogger, stdoutLogger)
import Network.IRC.Bot.Part.Channels (initChannelsPart)


parseConf :: Parser BotConf
parseConf = BotConf
  <$> pure Nothing
  <*> parseLogger
  <*> strOption
    (long "server" 
     <> short 's'
     <> metavar "HOST_OR_IP"
     <> value "localhost"
     <> help "IRC server to connect to")
  <*> option auto
    (long "port"
     <> short 'p'
     <> metavar "PORT"
     <> value 6667
     <> help "Port of the IRC server to use")
  <*> strOption
    (long "nick"
     <> short 'n'
     <> help "IRC nick")
  <*> strOption
    (long "cmd-prefix"
     <> short 'c'
     <> value "#"
     <> help "Bot command prefix")
  <*> parseUser
  <*> (Data.Set.fromList . map coercePrefixes <$>
     some (argument str
             (metavar "CHANNEL [CHANNEL]"
             <> help "IRC channels to join to, channel prefix # not required")
            ))
  <*> parseLimits

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

parseLogger :: Parser Logger
parseLogger = stdoutLogger
  <$> flag Normal Debug
    (long "debug"
     <> short 'd'
     <> help "Enable debug output")

parseUser :: Parser User
parseUser = User
  <$> strOption
    (long "username"
     <> help "Ident username")
  <*> strOption
    (long "hostname"
     <> help "Hostname of the client system")
  <*> pure "."
  <*> strOption
    (long "realname"
     <> help "Clients real name")

parseLimits :: Parser (Maybe (Int, Int))
parseLimits = optional $ (,)
  <$> option auto
    (long "burst-length"
     <> metavar "BURST"
     <> value 2
     <> help "Rate limit after a BURST limit of messages is reached")
  <*> option auto
    (long "delay-ms"
     <> metavar "MS"
     <> value 2
     <> help "Delay in microseconds for rate limiting")

opts :: ParserInfo BotConf
opts = info (parseConf <**> helper)
  ( fullDesc
  <> progDesc "ircbot"
  <> header "ircbot - Haskell IRC bot" )

-- | Run bot with user provided initialization
-- function returning bot parts
runBotWithParts :: (IO [BotPartT IO ()])
                -> IO ()
runBotWithParts initUserParts = do
  options <- execParser opts
  print $ user options
  print $ channels options

  ircParts <- initParts initUserParts (channels options)
  (tids, reconnect) <- simpleBot options ircParts
  hasStdin <- System.IO.isEOF
  case hasStdin of
    True -> Control.Monad.forever $ Control.Concurrent.threadDelay 1000000000
    False -> do
      let loop = do
            l <- getLine
            Control.Monad.unless ("quit" `Data.List.isPrefixOf` l) $ do
              reconnect
              loop

      loop
  mapM_ Control.Concurrent.killThread tids

-- Init channels part and all user parts
initParts :: (BotMonad m)
          => (IO [m ()])     -- ^ User provided parts
          -> Set ByteString  -- ^ Set of channels to join
          -> IO [m ()]
initParts initUser chans = do
  (_, channelsPart) <- initChannelsPart chans
  userParts <- initUser
  return $ channelsPart:userParts