handle the nicklist tedium
This commit is contained in:
parent
6edb35727f
commit
ee2859d4a1
@ -23,6 +23,7 @@ import qualified Data.Map as M
|
||||
import Data.ByteString(ByteString)
|
||||
import Network.IRC.CTCP(CTCPByteString(..))
|
||||
import Control.Applicative ((<$>), (<|>))
|
||||
import Data.List(nub,(\\))
|
||||
type MyNicknames = M.Map (T.Text) ([T.Text])
|
||||
|
||||
|
||||
@ -45,26 +46,50 @@ myChannels = ["#exquisitebot"]
|
||||
rPL_NAMREPLY :: Int
|
||||
rPL_NAMREPLY = 353
|
||||
|
||||
sendNAMES :: T.Text -> IRC s ()
|
||||
sendNAMES c = send $ RawMsg $ "NAMES " ♯ c
|
||||
|
||||
joinHandler' :: EventHandler s
|
||||
joinHandler' = EventHandler (\ev -> matchNumeric 331 ev <|> matchNumeric 332 ev) $ \_ args -> case args of
|
||||
(c:_) -> do
|
||||
send $ RawMsg $ "NAMES " ♯ c
|
||||
sendNAMES c
|
||||
_ -> pure ()
|
||||
|
||||
namesReplyHandler
|
||||
:: a -> TMVar (M.Map T.Text [T.Text]) -> EventHandler s
|
||||
namesReplyHandler mh nns = huntAlligators (matchNumeric' rPL_NAMREPLY (mh,nns)) $ \src ((mh,nns), (meirl:theEqualsSignAsASeparateElementWhyTheFuckNot:theChan:theNicknames:[])) -> do
|
||||
-- let fff = (T.breakOn " :" (foldr1 (\a b -> a ♯ " *BOINK* " ♯ b) thetail))
|
||||
-- (theChan,theNicknames) = fff & _2 %~ (T.splitOn " " . T.drop 1)
|
||||
grr <- liftIO . atomically $ do
|
||||
replaceNNS
|
||||
:: Ord k =>
|
||||
TMVar (M.Map k [T.Text]) -> k -> T.Text -> STM (M.Map k [T.Text])
|
||||
replaceNNS nns theChan theNicknames= do
|
||||
lnns <- takeTMVar nns
|
||||
let curList = M.lookup theChan lnns
|
||||
fff = M.insert theChan (case curList of
|
||||
Nothing -> T.splitOn " " theNicknames
|
||||
Just cl -> cl ++ (T.splitOn " " theNicknames)) lnns
|
||||
Just cl -> nub (cl ++ (T.splitOn " " theNicknames))) lnns
|
||||
putTMVar nns fff
|
||||
return fff
|
||||
liftIO $ putStrLn $ "what the fuck did I just do: " ++ show grr
|
||||
return ()
|
||||
|
||||
otherJoinHandler :: EventHandler s
|
||||
otherJoinHandler = huntAlligators (matchType _Join) $ \_ c -> sendNAMES c
|
||||
otherPartHandler :: EventHandler s
|
||||
otherPartHandler = huntAlligators (matchType _Part) $ \_ (c,_) -> sendNAMES c
|
||||
|
||||
removeFromNNS
|
||||
:: (Ord k, Eq a) =>
|
||||
TMVar (M.Map k [a]) -> k -> a -> STM (M.Map k [a])
|
||||
removeFromNNS nns theChan theNick = do
|
||||
lnns <- takeTMVar nns
|
||||
let curList = M.lookup theChan lnns
|
||||
fff = M.insert theChan (case curList of
|
||||
Nothing -> []
|
||||
Just cl -> nub (filter (/= theNick) cl)) lnns
|
||||
putTMVar nns fff
|
||||
return fff
|
||||
|
||||
namesReplyHandler
|
||||
:: a -> TMVar (M.Map T.Text [T.Text]) -> EventHandler s
|
||||
namesReplyHandler mh nns = huntAlligators (matchNumeric' rPL_NAMREPLY (mh,nns)) $
|
||||
\src ((mh,nns), (meirl:theEqualsSignAsASeparateElementWhyTheFuckNot:theChan:theNicknames:[])) ->
|
||||
(liftIO . atomically $ replaceNNS nns theChan theNicknames) >>= (liftIO . putStrLn . show)
|
||||
|
||||
|
||||
matchNumeric'
|
||||
:: Int -> a1 -> Event a2 -> Maybe (a1, [a2])
|
||||
@ -72,12 +97,14 @@ matchNumeric' n intruder ev = case _message ev of
|
||||
Numeric num args | n == num -> Just (intruder,args)
|
||||
_ -> Nothing
|
||||
|
||||
huntCrocodiles
|
||||
|
||||
|
||||
matchType'
|
||||
:: Getting (First b) (Message a1) b
|
||||
-> a2 -> Event a1 -> Maybe (a2, b)
|
||||
huntCrocodiles k mh ev = case preview k . _message $ ev of
|
||||
matchType' k intruder ev = case preview k . _message $ ev of
|
||||
Nothing -> Nothing
|
||||
Just sth -> Just (mh,sth)
|
||||
Just sth -> Just (intruder,sth)
|
||||
|
||||
unimplementedCommand :: T.Text
|
||||
unimplementedCommand = "Command not implemented."
|
||||
@ -88,8 +115,8 @@ huntAlligators
|
||||
-> (Source T.Text -> b -> IRC s ()) -> EventHandler s
|
||||
huntAlligators mf cf = EventHandler mf cf
|
||||
|
||||
fYourKickHandler :: Manhole -> EventHandler s
|
||||
fYourKickHandler mh = huntAlligators (huntCrocodiles _Kick mh) $ \src (mh, (channame, nickname, reason)) -> do
|
||||
|
||||
fYourKickHandler nns = huntAlligators (matchType' _Kick nns) $ \src (nns, (channame, nickname, reason)) -> do
|
||||
tvarI <- get instanceConfig <$> getIRCState
|
||||
iGotBooted <- liftIO . atomically $ do
|
||||
theNick <- get nick <$> readTVar tvarI
|
||||
@ -99,16 +126,16 @@ fYourKickHandler mh = huntAlligators (huntCrocodiles _Kick mh) $ \src (mh, (chan
|
||||
| otherwise -> False
|
||||
_ -> False
|
||||
if(iGotBooted) then do
|
||||
liftIO $ regift (Sewage mySignature (T.pack "got kicked from " ♯ channame)) mh
|
||||
-- liftIO $ regift (Sewage mySignature (T.pack "got kicked from " ♯ channame)) mh
|
||||
liftIO (threadDelay 10000000)
|
||||
send $ Join channame
|
||||
else return ()
|
||||
else liftIO . atomically $ removeFromNNS nns nickname channame >> return ()
|
||||
|
||||
spamCoordinator :: Manhole -> T.Text -> IO ()
|
||||
spamCoordinator mh msg = regift (Sewage mySignature msg) mh
|
||||
|
||||
detectCommandHandler :: Manhole -> EventHandler s
|
||||
detectCommandHandler mh = huntAlligators (huntCrocodiles _Privmsg mh) $ \src (mh,(tgt,blergh)) -> do
|
||||
detectCommandHandler mh = huntAlligators (matchType' _Privmsg mh) $ \src (mh,(tgt,blergh)) -> do
|
||||
tvarI <- get instanceConfig <$> getIRCState
|
||||
case blergh of
|
||||
Right body -> do
|
||||
@ -146,12 +173,13 @@ initPlugin mh = do
|
||||
}
|
||||
}
|
||||
}
|
||||
rejoinOnKickHandler = fYourKickHandler mh
|
||||
|
||||
detectCommandHandler' = detectCommandHandler mh
|
||||
conn = tlsConnection $ WithClientConfig myClientConfig
|
||||
myNNS <- atomically $ newTMVar M.empty
|
||||
let namesReplyHandler' = namesReplyHandler mh myNNS
|
||||
mySpecialHandlers = [rejoinOnKickHandler,detectCommandHandler',joinHandler',namesReplyHandler']
|
||||
rejoinOnKickHandler = fYourKickHandler myNNS
|
||||
mySpecialHandlers = [rejoinOnKickHandler,detectCommandHandler',joinHandler',namesReplyHandler',otherJoinHandler,otherPartHandler]
|
||||
cfg = defaultInstanceConfig myNickname & channels %~ (myChannels ++) & handlers %~ (++ mySpecialHandlers)
|
||||
forkIO $ runClient conn cfg ()
|
||||
return GoodInitStatus
|
||||
|
Loading…
x
Reference in New Issue
Block a user