{-# OPTIONS -fglasgow-exts #-} module Esotericbot.Chanop where import Data.Attoparsec import Data.List.Stream as L import Data.Map as M import Data.ByteString.Unsafe import Control.Concurrent.STM import Control.Concurrent import System.IO import Esotericbot.EBTypes import Esotericbot.BSH import Esotericbot.IRCCom import Esotericbot.BSUtils op_cmd :: Handle -> Command -> SmallBotM ( ) op_cmd h cmd = do sb <- get maybe ( do not_in_room <- liftIO $ unsafePackAddressLen 42 "You can't do that unless you're in a room."# privmsg h ( irc_user cmd ) not_in_room ) id $ do chan <- irc_chan cmd chan_op_search <- M.lookup chan $ searching sb return $ known_op_cmd h chan_op_search cmd -- this is some multiplexing right here boyo known_op_cmd :: Handle -> TVar ChanOpSearch -> Command -> SmallBotM ( ) known_op_cmd h op_search_var cmd = do sb <- get let Just chan = irc_chan cmd wait_for_end = atomically $ do op_search <- readTVar op_search_var if done op_search then do op_search <- readTVar op_search_var let other_threads = threads_waiting op_search - 1 if other_threads < 1 then writeTVar op_search_var initial_op_search else writeTVar op_search_var $ op_search { threads_waiting = other_threads } return $ ops op_search else do retry start_gathering = do starting <- liftIO $ atomically $ do op_search <- readTVar op_search_var if not $ underway op_search then do writeTVar op_search_var $ op_search { underway = True } return True else return False request_names <- liftIO $ ls2bs 6 "NAMES "# writeMsg h $ request_names `hAppend` chan liftIO $ wait_for_end -- if the names are being gathered -- wait until the end -- if the names are not being gathered, start gathering op_search <- liftIO $ atomically $ do op_search <- readTVar op_search_var writeTVar op_search_var $ op_search { threads_waiting = threads_waiting op_search + 1 } return op_search the_ops <- if underway op_search then liftIO $ wait_for_end else start_gathering if irc_user cmd `L.elem` the_ops then do know_better <- liftIO $ ls2bs 27 "Pull yourself together man!"# talk <- liftIO $ ls2bs 6 "enable"# dont <- liftIO $ ls2bs 7 "disable"# either ( const $ priv_msg h cmd know_better ) id $ snd $ parse ( op_cmd_p sb h talk dont chan ) $ irc_cmd cmd else do denied <- liftIO $ ls2bs 3 "HA!"# privmsg h chan denied op_cmd_p sb h talk dont chan = do spaces try ( do string talk return $ do enabled <- liftIO $ ls2bs 7 "Enabled"# enable_bot chan privmsg h chan enabled ) <|> do string dont return $ do disabled <- liftIO $ ls2bs 8 "Disabled"# disable_bot chan privmsg h chan disabled enable_bot chan = write_listening chan True disable_bot chan = write_listening chan False write_listening chan p = do sb <- get let Just lvar = M.lookup chan $ listening sb liftIO $ atomically $ writeTVar lvar p