-- {-# 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.Run (
    runBotWithParts
  ) where

import Data.ByteString            (ByteString)
import Data.Set                   (Set)
import Options.Applicative        (Parser)

import qualified Control.Concurrent
import qualified Control.Monad
import qualified Data.List
import qualified System.IO

import Network.IRC.Bot.BotMonad   (BotMonad(..), BotPartT)
import Network.IRC.Bot.Core       (BotConf(..), simpleBot)
import Network.IRC.Bot.Options    (execBotOptsParser)
import Network.IRC.Bot.Part.Channels (initChannelsPart)
import Network.IRC.Bot.Part.Ping     (pingPart)


-- | Run bot with user provided initialization
-- function returning bot parts.
runBotWithParts :: IO [BotPartT IO ()] -> IO ()
runBotWithParts :: IO [BotPartT IO ()] -> IO ()
runBotWithParts IO [BotPartT IO ()]
parts = Parser () -> (() -> IO [BotPartT IO ()]) -> IO ()
forall extra.
Parser extra -> (extra -> IO [BotPartT IO ()]) -> IO ()
runBotWithParts' (() -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO [BotPartT IO ()] -> () -> IO [BotPartT IO ()]
forall a b. a -> b -> a
const IO [BotPartT IO ()]
parts)

-- | Run bot with user provided initialization
-- function returning bot parts.
--
-- Accepts another `optparse-applicative` `Parser` for extending
-- built-in one.
runBotWithParts' :: Parser extra
                -> (extra -> IO [BotPartT IO ()])
                -> IO ()
runBotWithParts' :: Parser extra -> (extra -> IO [BotPartT IO ()]) -> IO ()
runBotWithParts' Parser extra
extrasParser extra -> IO [BotPartT IO ()]
initUserParts = do
  (BotConf
botOptions, extra
extras) <- Parser extra -> IO (BotConf, extra)
forall extra. Parser extra -> IO (BotConf, extra)
execBotOptsParser Parser extra
extrasParser

  [BotPartT IO ()]
ircParts <- IO [BotPartT IO ()] -> Set ByteString -> IO [BotPartT IO ()]
forall (m :: * -> *).
BotMonad m =>
IO [m ()] -> Set ByteString -> IO [m ()]
initParts (extra -> IO [BotPartT IO ()]
initUserParts extra
extras) (BotConf -> Set ByteString
channels BotConf
botOptions)
  ([ThreadId]
tids, IO ()
reconnect) <- BotConf -> [BotPartT IO ()] -> IO ([ThreadId], IO ())
simpleBot BotConf
botOptions [BotPartT IO ()]
ircParts
  Bool
hasStdin <- IO Bool
System.IO.isEOF
  case Bool
hasStdin of
    Bool
True -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
Control.Monad.forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
Control.Concurrent.threadDelay Int
1000000000
    Bool
False -> do
      let loop :: IO ()
loop = do
            String
l <- IO String
getLine
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless (String
"quit" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`Data.List.isPrefixOf` String
l) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              IO ()
reconnect
              IO ()
loop

      IO ()
loop
  (ThreadId -> IO ()) -> [ThreadId] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ThreadId -> IO ()
Control.Concurrent.killThread [ThreadId]
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 :: IO [m ()] -> Set ByteString -> IO [m ()]
initParts IO [m ()]
initUser Set ByteString
chans = do
  (TVar (Set ByteString)
_, m ()
channelsPart) <- Set ByteString -> IO (TVar (Set ByteString), m ())
forall (m :: * -> *).
BotMonad m =>
Set ByteString -> IO (TVar (Set ByteString), m ())
initChannelsPart Set ByteString
chans
  [m ()]
userParts <- IO [m ()]
initUser
  [m ()] -> IO [m ()]
forall (m :: * -> *) a. Monad m => a -> m a
return ([m ()] -> IO [m ()]) -> [m ()] -> IO [m ()]
forall a b. (a -> b) -> a -> b
$ m ()
channelsPartm () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
:m ()
forall (m :: * -> *). BotMonad m => m ()
pingPartm () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
:[m ()]
userParts