esotericbot-0.0.1: Esotericbot/Chanop.hs

{-# OPTIONS -fglasgow-exts #-}
module Esotericbot.Chanop where

import Data.Attoparsec
import Data.List.Stream as L
import Data.Time
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