1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
-- {-# 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 parts = runBotWithParts' (pure ()) (const 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' extrasParser initUserParts = do
(botOptions, extras) <- execBotOptsParser extrasParser
ircParts <- initParts (initUserParts extras) (channels botOptions)
(tids, reconnect) <- simpleBot botOptions 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:pingPart:userParts
|
