{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Network.IRC.Client.Events
(
EventHandler(..)
, matchCTCP
, matchNumeric
, matchType
, matchWhen
, defaultEventHandlers
, defaultOnConnect
, defaultOnDisconnect
, pingHandler
, kickHandler
, ctcpPingHandler
, ctcpVersionHandler
, ctcpTimeHandler
, welcomeNick
, joinOnWelcome
, joinHandler
, nickMangler
, Event(..)
, Message(..)
, Source(..)
, module Network.IRC.Conduit.Lens
) where
import Control.Applicative ((<$>), (<|>))
import Control.Concurrent.STM (atomically, modifyTVar, readTVar)
import Control.Monad.Catch (SomeException, fromException,
throwM)
import Control.Monad.IO.Class (liftIO)
import Data.Char (isAlphaNum)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text, breakOn, takeEnd, toUpper)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format (formatTime)
import Network.IRC.CTCP (fromCTCP)
import Network.IRC.Conduit (Event(..), Message(..),
Source(..))
import Network.IRC.Conduit.Lens
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
import qualified Data.Text as T
import Network.IRC.Client.Internal
import Network.IRC.Client.Lens
import Network.IRC.Client.Utils
matchCTCP :: Text -> Event Text -> Maybe [Text]
matchCTCP :: Text -> Event Text -> Maybe [Text]
matchCTCP Text
verb Event Text
ev = case Event Text -> Message Text
forall a. Event a -> Message a
_message Event Text
ev of
Privmsg Text
_ (Left CTCPByteString
ctcpbs) ->
let (Text
v, [Text]
args) = CTCPByteString -> (Text, [Text])
fromCTCP CTCPByteString
ctcpbs
in if Text -> Text
toUpper Text
verb Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
toUpper Text
v
then [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
args
else Maybe [Text]
forall a. Maybe a
Nothing
Message Text
_ -> Maybe [Text]
forall a. Maybe a
Nothing
matchNumeric :: Int -> Event a -> Maybe [a]
matchNumeric :: Int -> Event a -> Maybe [a]
matchNumeric Int
num Event a
ev = case Event a -> Message a
forall a. Event a -> Message a
_message Event a
ev of
Numeric Int
n [a]
args | Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
args
Message a
_ -> Maybe [a]
forall a. Maybe a
Nothing
matchType :: Prism' (Message a) b -> Event a -> Maybe b
matchType :: Prism' (Message a) b -> Event a -> Maybe b
matchType Prism' (Message a) b
k = Prism' (Message a) b -> Message a -> Maybe b
forall s a. Prism' s a -> s -> Maybe a
preview Prism' (Message a) b
k (Message a -> Maybe b)
-> (Event a -> Message a) -> Event a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Message a
forall a. Event a -> Message a
_message
matchWhen :: (Event a -> Bool) -> Event a -> Maybe (Message a)
matchWhen :: (Event a -> Bool) -> Event a -> Maybe (Message a)
matchWhen Event a -> Bool
p Event a
ev | Event a -> Bool
p Event a
ev = Message a -> Maybe (Message a)
forall a. a -> Maybe a
Just (Event a -> Message a
forall a. Event a -> Message a
_message Event a
ev)
matchWhen Event a -> Bool
_ Event a
_ = Maybe (Message a)
forall a. Maybe a
Nothing
defaultEventHandlers :: [EventHandler s]
defaultEventHandlers :: [EventHandler s]
defaultEventHandlers =
[ EventHandler s
forall s. EventHandler s
pingHandler
, EventHandler s
forall s. EventHandler s
kickHandler
, EventHandler s
forall s. EventHandler s
ctcpPingHandler
, EventHandler s
forall s. EventHandler s
ctcpTimeHandler
, EventHandler s
forall s. EventHandler s
ctcpVersionHandler
, EventHandler s
forall s. EventHandler s
welcomeNick
, EventHandler s
forall s. EventHandler s
joinOnWelcome
, EventHandler s
forall s. EventHandler s
joinHandler
, EventHandler s
forall s. EventHandler s
nickMangler
]
defaultOnConnect :: IRC s ()
defaultOnConnect :: IRC s ()
defaultOnConnect = do
InstanceConfig s
iconf <- Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> IRC s (InstanceConfig s)
forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> IRC s (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (InstanceConfig s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ())
-> (Text -> Message Text) -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Message Text
forall a. NickName a -> Message (NickName a)
Nick (Text -> IRC s ()) -> Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Getting Text (InstanceConfig s) Text -> InstanceConfig s -> Text
forall a s. Getting a s a -> s -> a
get Getting Text (InstanceConfig s) Text
forall s. Lens' (InstanceConfig s) Text
nick InstanceConfig s
iconf
defaultOnDisconnect :: Maybe SomeException -> IRC s ()
defaultOnDisconnect :: Maybe SomeException -> IRC s ()
defaultOnDisconnect (Just SomeException
exc) = case SomeException -> Maybe Timeout
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exc of
Just Timeout
Timeout -> IRC s ()
forall s. IRC s ()
reconnect
Maybe Timeout
Nothing -> SomeException -> IRC s ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
exc
defaultOnDisconnect Maybe SomeException
Nothing = () -> IRC s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
pingHandler :: EventHandler s
pingHandler :: EventHandler s
pingHandler = (Event Text -> Maybe (Text, Maybe Text))
-> (Source Text -> (Text, Maybe Text) -> IRC s ())
-> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Prism' (Message Text) (Text, Maybe Text)
-> Event Text -> Maybe (Text, Maybe Text)
forall a b. Prism' (Message a) b -> Event a -> Maybe b
matchType forall a. Prism' (Message a) (a, Maybe a)
Prism' (Message Text) (Text, Maybe Text)
_Ping) ((Source Text -> (Text, Maybe Text) -> IRC s ()) -> EventHandler s)
-> (Source Text -> (Text, Maybe Text) -> IRC s ())
-> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
_ (Text
s1, Maybe Text
s2) ->
Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ())
-> (Text -> Message Text) -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Message Text
forall a. NickName a -> Message (NickName a)
Pong (Text -> IRC s ()) -> Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
s1 Maybe Text
s2
ctcpPingHandler :: EventHandler s
ctcpPingHandler :: EventHandler s
ctcpPingHandler = (Event Text -> Maybe [Text])
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Text -> Event Text -> Maybe [Text]
matchCTCP Text
"PING") ((Source Text -> [Text] -> IRC s ()) -> EventHandler s)
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
src [Text]
args -> case Source Text
src of
User Text
n -> Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ()) -> Message Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> Message Text
ctcpReply Text
n Text
"PING" [Text]
args
Source Text
_ -> () -> IRC s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ctcpVersionHandler :: EventHandler s
ctcpVersionHandler :: EventHandler s
ctcpVersionHandler = (Event Text -> Maybe [Text])
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Text -> Event Text -> Maybe [Text]
matchCTCP Text
"VERSION") ((Source Text -> [Text] -> IRC s ()) -> EventHandler s)
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
src [Text]
_ -> case Source Text
src of
User Text
n -> do
Text
ver <- Getting Text (InstanceConfig s) Text -> InstanceConfig s -> Text
forall a s. Getting a s a -> s -> a
get Getting Text (InstanceConfig s) Text
forall s. Lens' (InstanceConfig s) Text
version (InstanceConfig s -> Text)
-> IRC s (InstanceConfig s) -> IRC s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> IRC s (InstanceConfig s)
forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> IRC s (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (InstanceConfig s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState)
Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ()) -> Message Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> Message Text
ctcpReply Text
n Text
"VERSION" [Text
ver]
Source Text
_ -> () -> IRC s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ctcpTimeHandler :: EventHandler s
ctcpTimeHandler :: EventHandler s
ctcpTimeHandler = (Event Text -> Maybe [Text])
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Text -> Event Text -> Maybe [Text]
matchCTCP Text
"TIME") ((Source Text -> [Text] -> IRC s ()) -> EventHandler s)
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
src [Text]
_ -> case Source Text
src of
User Text
n -> do
UTCTime
now <- IO UTCTime -> IRC s UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ()) -> Message Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> Message Text
ctcpReply Text
n Text
"TIME" [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%c" UTCTime
now]
Source Text
_ -> () -> IRC s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
welcomeNick :: EventHandler s
welcomeNick :: EventHandler s
welcomeNick = (Event Text -> Maybe [Text])
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Int -> Event Text -> Maybe [Text]
forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
001) ((Source Text -> [Text] -> IRC s ()) -> EventHandler s)
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
_ [Text]
args -> case [Text]
args of
(Text
srvNick:[Text]
_) -> do
TVar (InstanceConfig s)
tvarI <- Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> TVar (InstanceConfig s)
forall a s. Getting a s a -> s -> a
get Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> TVar (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (TVar (InstanceConfig s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
IO () -> IRC s ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IRC s ()) -> (STM () -> IO ()) -> STM () -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IRC s ()) -> STM () -> IRC s ()
forall a b. (a -> b) -> a -> b
$
TVar (InstanceConfig s)
-> (InstanceConfig s -> InstanceConfig s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI (Lens' (InstanceConfig s) Text
-> Text -> InstanceConfig s -> InstanceConfig s
forall s a. Lens' s a -> a -> s -> s
set forall s. Lens' (InstanceConfig s) Text
Lens' (InstanceConfig s) Text
nick Text
srvNick)
[] -> () -> IRC s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
joinOnWelcome :: EventHandler s
joinOnWelcome :: EventHandler s
joinOnWelcome = (Event Text -> Maybe [Text])
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Int -> Event Text -> Maybe [Text]
forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
001) ((Source Text -> [Text] -> IRC s ()) -> EventHandler s)
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
_ [Text]
_ -> do
InstanceConfig s
iconf <- Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> IRC s (InstanceConfig s)
forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> IRC s (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (InstanceConfig s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
(Text -> IRC s ()) -> [Text] -> IRC s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ())
-> (Text -> Message Text) -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Message Text
forall a. NickName a -> Message (NickName a)
Join) ([Text] -> IRC s ()) -> [Text] -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Getting [Text] (InstanceConfig s) [Text]
-> InstanceConfig s -> [Text]
forall a s. Getting a s a -> s -> a
get Getting [Text] (InstanceConfig s) [Text]
forall s. Lens' (InstanceConfig s) [Text]
channels InstanceConfig s
iconf
nickMangler :: EventHandler s
nickMangler :: EventHandler s
nickMangler = (Event Text -> Maybe (Text -> Text, [Text]))
-> (Source Text -> (Text -> Text, [Text]) -> IRC s ())
-> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (\Event Text
ev -> Int -> (Text -> Text) -> Event Text -> Maybe (Text -> Text, [Text])
forall a a. Int -> a -> Event a -> Maybe (a, [a])
matcher Int
432 Text -> Text
fresh Event Text
ev Maybe (Text -> Text, [Text])
-> Maybe (Text -> Text, [Text]) -> Maybe (Text -> Text, [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> (Text -> Text) -> Event Text -> Maybe (Text -> Text, [Text])
forall a a. Int -> a -> Event a -> Maybe (a, [a])
matcher Int
433 Text -> Text
mangle Event Text
ev Maybe (Text -> Text, [Text])
-> Maybe (Text -> Text, [Text]) -> Maybe (Text -> Text, [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> (Text -> Text) -> Event Text -> Maybe (Text -> Text, [Text])
forall a a. Int -> a -> Event a -> Maybe (a, [a])
matcher Int
436 Text -> Text
mangle Event Text
ev) ((Source Text -> (Text -> Text, [Text]) -> IRC s ())
-> EventHandler s)
-> (Source Text -> (Text -> Text, [Text]) -> IRC s ())
-> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
_ -> ((Text -> Text) -> [Text] -> IRC s ())
-> (Text -> Text, [Text]) -> IRC s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text -> Text) -> [Text] -> IRC s ()
forall s. (Text -> Text) -> [Text] -> IRC s ()
go
where
matcher :: Int -> a -> Event a -> Maybe (a, [a])
matcher Int
num a
f Event a
ev = case Event a -> Message a
forall a. Event a -> Message a
_message Event a
ev of
Numeric Int
n [a]
args | Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
f, [a]
args)
Message a
_ -> Maybe (a, [a])
forall a. Maybe a
Nothing
go :: (Text -> Text) -> [Text] -> IRC s ()
go Text -> Text
f (Text
_:Text
srvNick:[Text]
_) = do
Text
theNick <- Getting Text (InstanceConfig s) Text -> InstanceConfig s -> Text
forall a s. Getting a s a -> s -> a
get Getting Text (InstanceConfig s) Text
forall s. Lens' (InstanceConfig s) Text
nick (InstanceConfig s -> Text)
-> IRC s (InstanceConfig s) -> IRC s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> IRC s (InstanceConfig s)
forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> IRC s (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (InstanceConfig s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState)
let nicklen :: Maybe Int
nicklen = if Text -> Int
T.length Text
srvNick Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Int
T.length Text
theNick
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
srvNick
else Maybe Int
forall a. Maybe a
Nothing
Text -> IRC s ()
forall s. Text -> IRC s ()
setNick (Text -> IRC s ()) -> (Text -> Text) -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Text -> Text
trunc Maybe Int
nicklen (Text -> IRC s ()) -> Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
f Text
srvNick
go Text -> Text
_ [Text]
_ = () -> IRC s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fresh :: Text -> Text
fresh Text
n = if Text -> Int
T.length Text
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
"f" else Text
n'
where n' :: Text
n' = (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isAlphaNum Text
n
mangle :: Text -> Text
mangle Text
n = (Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"1") Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
`fromMaybe` Text -> Maybe Text
charsubst Text
n
trunc :: Maybe Int -> Text -> Text
trunc Maybe Int
len Text
txt = Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
txt (Int -> Text -> Text
`takeEnd` Text
txt) Maybe Int
len
charsubst :: Text -> Maybe Text
charsubst = [(Text, Text)] -> Text -> Maybe Text
transform [ (Text
"i", Text
"1")
, (Text
"I", Text
"1")
, (Text
"l", Text
"1")
, (Text
"L", Text
"1")
, (Text
"o", Text
"0")
, (Text
"O", Text
"0")
, (Text
"A", Text
"4")
, (Text
"0", Text
"1")
, (Text
"1", Text
"2")
, (Text
"2", Text
"3")
, (Text
"3", Text
"4")
, (Text
"4", Text
"5")
, (Text
"5", Text
"6")
, (Text
"6", Text
"7")
, (Text
"7", Text
"8")
, (Text
"8", Text
"9")
, (Text
"9", Text
"-")
]
transform :: [(Text, Text)] -> Text -> Maybe Text
transform ((Text
from, Text
to):[(Text, Text)]
trs) Text
txt = case Text -> Text -> Maybe (Text, Text)
breakOn' Text
from Text
txt of
Just (Text
before, Text
after) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
before Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
to Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
after
Maybe (Text, Text)
_ -> [(Text, Text)] -> Text -> Maybe Text
transform [(Text, Text)]
trs Text
txt
transform [] Text
_ = Maybe Text
forall a. Maybe a
Nothing
joinHandler :: EventHandler s
joinHandler :: EventHandler s
joinHandler = (Event Text -> Maybe [Text])
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (\Event Text
ev -> Int -> Event Text -> Maybe [Text]
forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
331 Event Text
ev Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Event Text -> Maybe [Text]
forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
332 Event Text
ev) ((Source Text -> [Text] -> IRC s ()) -> EventHandler s)
-> (Source Text -> [Text] -> IRC s ()) -> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
_ [Text]
args -> case [Text]
args of
(Text
c:[Text]
_) -> do
TVar (InstanceConfig s)
tvarI <- Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> TVar (InstanceConfig s)
forall a s. Getting a s a -> s -> a
get Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> TVar (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (TVar (InstanceConfig s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
IO () -> IRC s ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IRC s ()) -> (STM () -> IO ()) -> STM () -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IRC s ()) -> STM () -> IRC s ()
forall a b. (a -> b) -> a -> b
$
TVar (InstanceConfig s)
-> (InstanceConfig s -> InstanceConfig s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI ((InstanceConfig s -> InstanceConfig s) -> STM ())
-> (InstanceConfig s -> InstanceConfig s) -> STM ()
forall a b. (a -> b) -> a -> b
$ \InstanceConfig s
iconf ->
(if Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Getting [Text] (InstanceConfig s) [Text]
-> InstanceConfig s -> [Text]
forall a s. Getting a s a -> s -> a
get Getting [Text] (InstanceConfig s) [Text]
forall s. Lens' (InstanceConfig s) [Text]
channels InstanceConfig s
iconf
then Lens' (InstanceConfig s) [Text]
-> ([Text] -> [Text]) -> InstanceConfig s -> InstanceConfig s
forall s a. Lens' s a -> (a -> a) -> s -> s
modify forall s. Lens' (InstanceConfig s) [Text]
Lens' (InstanceConfig s) [Text]
channels (Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
else InstanceConfig s -> InstanceConfig s
forall a. a -> a
id) InstanceConfig s
iconf
[Text]
_ -> () -> IRC s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
kickHandler :: EventHandler s
kickHandler :: EventHandler s
kickHandler = (Event Text -> Maybe (Text, Text, Maybe Text))
-> (Source Text -> (Text, Text, Maybe Text) -> IRC s ())
-> EventHandler s
forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Prism' (Message Text) (Text, Text, Maybe Text)
-> Event Text -> Maybe (Text, Text, Maybe Text)
forall a b. Prism' (Message a) b -> Event a -> Maybe b
matchType forall a. Prism' (Message a) (a, a, Reason a)
Prism' (Message Text) (Text, Text, Maybe Text)
_Kick) ((Source Text -> (Text, Text, Maybe Text) -> IRC s ())
-> EventHandler s)
-> (Source Text -> (Text, Text, Maybe Text) -> IRC s ())
-> EventHandler s
forall a b. (a -> b) -> a -> b
$ \Source Text
src (Text
n, Text
_, Maybe Text
_) -> do
TVar (InstanceConfig s)
tvarI <- Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> TVar (InstanceConfig s)
forall a s. Getting a s a -> s -> a
get Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> TVar (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (TVar (InstanceConfig s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
IO () -> IRC s ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IRC s ()) -> (STM () -> IO ()) -> STM () -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IRC s ()) -> STM () -> IRC s ()
forall a b. (a -> b) -> a -> b
$ do
Text
theNick <- Getting Text (InstanceConfig s) Text -> InstanceConfig s -> Text
forall a s. Getting a s a -> s -> a
get Getting Text (InstanceConfig s) Text
forall s. Lens' (InstanceConfig s) Text
nick (InstanceConfig s -> Text) -> STM (InstanceConfig s) -> STM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (InstanceConfig s) -> STM (InstanceConfig s)
forall a. TVar a -> STM a
readTVar TVar (InstanceConfig s)
tvarI
case Source Text
src of
Channel Text
c Text
_
| Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
theNick -> TVar (InstanceConfig s) -> Text -> STM ()
forall s. TVar (InstanceConfig s) -> Text -> STM ()
delChan TVar (InstanceConfig s)
tvarI Text
c
| Bool
otherwise -> () -> STM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Source Text
_ -> () -> STM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
breakOn' :: Text -> Text -> Maybe (Text, Text)
breakOn' :: Text -> Text -> Maybe (Text, Text)
breakOn' Text
delim Text
txt = if Text -> Int
T.length Text
after Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
delim
then (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
before, Int -> Text -> Text
T.drop (Text -> Int
T.length Text
delim) Text
after)
else Maybe (Text, Text)
forall a. Maybe a
Nothing
where
(Text
before, Text
after) = Text -> Text -> (Text, Text)
breakOn Text
delim Text
txt