{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Network.IRC.Client.Events
-- Copyright   : (c) 2017 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : experimental
-- Portability : CPP, OverloadedStrings, RankNTypes
--
-- Events and event handlers. When a message is received from the
-- server, all matching handlers are executed sequentially in the
-- order that they appear in the 'handlers' list.
module Network.IRC.Client.Events
  ( -- * Handlers
    EventHandler(..)
  , matchCTCP
  , matchNumeric
  , matchType
  , matchWhen

  -- * Default handlers
  , defaultEventHandlers
  , defaultOnConnect
  , defaultOnDisconnect

  -- ** Individual handlers
  , pingHandler
  , kickHandler
  , ctcpPingHandler
  , ctcpVersionHandler
  , ctcpTimeHandler
  , welcomeNick
  , joinOnWelcome
  , joinHandler
  , nickMangler

  -- * Re-exported
  , 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.Conduit         (Event(..), Message(..),
                                              Source(..))
import           Network.IRC.Conduit.Lens
import           Network.IRC.CTCP            (fromCTCP)

#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


-------------------------------------------------------------------------------
-- Handlers

-- | Match the verb of a CTCP, ignoring case, and returning the arguments.
--
-- > matchCTCP "ping"   ":foo PRIVMSG #bar :\001PING\001"          ==> Just []
-- > matchCTCP "PING"   ":foo PRIVMSG #bar :\001PING\001"          ==> Just []
-- > matchCTCP "ACTION" ":foo PRIVMSG #bar :\001ACTION dances\001" ==> Just ["dances"]
matchCTCP :: Text -> Event Text -> Maybe [Text]
matchCTCP :: Text -> Event Text -> Maybe [Text]
matchCTCP Text
verb Event Text
ev = case 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 forall a. Eq a => a -> a -> Bool
== Text -> Text
toUpper Text
v
       then forall a. a -> Maybe a
Just [Text]
args
       else forall a. Maybe a
Nothing
  Message Text
_ -> forall a. Maybe a
Nothing

-- | Match a numeric server message. Numeric messages are sent in
-- response to most things, such as connecting to the server, or
-- joining a channel.
--
-- Numerics in the range 001 to 099 are informative messages, numerics
-- in the range 200 to 399 are responses to commands. Some common
-- numerics are:
--
--    - 001 (RPL_WELCOME), sent after successfully connecting.
--
--    - 331 (RPL_NOTOPIC), sent after joining a channel if it has no
--      topic.
--
--    - 332 (RPL_TOPIC), sent after joining a channel if it has a
--      topic.
--
--    - 432 (ERR_ERRONEUSNICKNAME), sent after trying to change to an
--      invalid nick.
--
--    - 433 (ERR_NICKNAMEINUSE), sent after trying to change to a nick
--      already in use.
--
--    - 436 (ERR_NICKCOLLISION), sent after trying to change to a nick
--      in use on another server.
--
-- See Section 5 of @<https://tools.ietf.org/html/rfc2812#section-5
-- RFC 2812>@ for a complete list.
--
-- > matchNumeric 001 "001 :Welcome to irc.example.com" ==> True
-- > matchNumeric 332 "332 :#haskell: We like Haskell"  ==> True
matchNumeric :: Int -> Event a -> Maybe [a]
matchNumeric :: forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
num Event a
ev = case forall a. Event a -> Message a
_message Event a
ev of
  Numeric Int
n [a]
args | Int
num forall a. Eq a => a -> a -> Bool
== Int
n -> forall a. a -> Maybe a
Just [a]
args
  Message a
_ -> forall a. Maybe a
Nothing

-- | Match events of the given type. Refer to
-- "Network.IRC.Conduit.Lens#Message" for the list of 'Prism''s.
--
-- > matchType _Privmsg ":foo PRIVMSG #bar :hello world" ==> Just ("#bar", Right "hello world")
-- > matchType _Quit    ":foo QUIT :goodbye world"       ==> Just (Just "goodbye world")
matchType :: Prism' (Message a) b -> Event a -> Maybe b
matchType :: forall a b. Prism' (Message a) b -> Event a -> Maybe b
matchType Prism' (Message a) b
k = forall s a. Prism' s a -> s -> Maybe a
preview Prism' (Message a) b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Event a -> Message a
_message

-- | Match a predicate against an event.
--
-- > matchWhen (const True) ":foo PRIVMSG #bar :hello world" ==> Just ":foo PRIVMSG :hello world"
matchWhen :: (Event a -> Bool) -> Event a -> Maybe (Message a)
matchWhen :: forall a. (Event a -> Bool) -> Event a -> Maybe (Message a)
matchWhen Event a -> Bool
p Event a
ev | Event a -> Bool
p Event a
ev = forall a. a -> Maybe a
Just (forall a. Event a -> Message a
_message Event a
ev)
matchWhen Event a -> Bool
_ Event a
_ = forall a. Maybe a
Nothing


-------------------------------------------------------------------------------
-- Default handlers

-- | The default event handlers, the following are included:
--
-- - respond to server @PING@ messages with a @PONG@;
-- - respond to CTCP @PING@ requests;
-- - respond to CTCP @VERSION@ requests with the version string;
-- - respond to CTCP @TIME@ requests with the system time;
-- - update the nick upon receiving the welcome message, in case the
--   server modifies it;
-- - mangle the nick if the server reports a collision;
-- - update the channel list on @JOIN@ and @KICK@.
defaultEventHandlers :: [EventHandler s]
defaultEventHandlers :: forall s. [EventHandler s]
defaultEventHandlers =
  [ forall s. EventHandler s
pingHandler
  , forall s. EventHandler s
kickHandler
  , forall s. EventHandler s
ctcpPingHandler
  , forall s. EventHandler s
ctcpTimeHandler
  , forall s. EventHandler s
ctcpVersionHandler
  , forall s. EventHandler s
welcomeNick
  , forall s. EventHandler s
joinOnWelcome
  , forall s. EventHandler s
joinHandler
  , forall s. EventHandler s
nickMangler
  ]

-- | The default connect handler: set the nick.
defaultOnConnect :: IRC s ()
defaultOnConnect :: forall s. IRC s ()
defaultOnConnect = do
  InstanceConfig s
iconf <- forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. IRC s (IRCState s)
getIRCState
  forall s. Message Text -> IRC s ()
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NickName a -> Message (NickName a)
Nick forall a b. (a -> b) -> a -> b
$ forall a s. Getting a s a -> s -> a
get forall s. Lens' (InstanceConfig s) Text
nick InstanceConfig s
iconf

-- | The default disconnect handler
--
--    - If the client disconnected due to a 'Timeout' exception, reconnect.
--
--    - If the client disconnected due to another exception, rethrow it.
--
--    - If the client disconnected without an exception, halt.
defaultOnDisconnect :: Maybe SomeException -> IRC s ()
defaultOnDisconnect :: forall s. Maybe SomeException -> IRC s ()
defaultOnDisconnect (Just SomeException
exc) = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exc of
  Just Timeout
Timeout -> forall s. IRC s ()
reconnect
  Maybe Timeout
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
exc
defaultOnDisconnect Maybe SomeException
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-------------------------------------------------------------------------------
-- Individual handlers

-- | Respond to server @PING@ messages with a @PONG@.
pingHandler :: EventHandler s
pingHandler :: forall s. EventHandler s
pingHandler = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (forall a b. Prism' (Message a) b -> Event a -> Maybe b
matchType forall a. Prism' (Message a) (a, Maybe a)
_Ping) forall a b. (a -> b) -> a -> b
$ \Source Text
_ (Text
s1, Maybe Text
s2) ->
  forall s. Message Text -> IRC s ()
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NickName a -> Message (NickName a)
Pong forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
s1 Maybe Text
s2

-- | Respond to CTCP @PING@ requests.
ctcpPingHandler :: EventHandler s
ctcpPingHandler :: forall s. EventHandler s
ctcpPingHandler = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Text -> Event Text -> Maybe [Text]
matchCTCP Text
"PING") forall a b. (a -> b) -> a -> b
$ \Source Text
src [Text]
args -> case Source Text
src of
  User Text
n -> forall s. Message Text -> IRC s ()
send forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> Message Text
ctcpReply Text
n Text
"PING" [Text]
args
  Source Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Respond to CTCP @VERSION@ requests with the version string.
ctcpVersionHandler :: EventHandler s
ctcpVersionHandler :: forall s. EventHandler s
ctcpVersionHandler = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Text -> Event Text -> Maybe [Text]
matchCTCP Text
"VERSION") forall a b. (a -> b) -> a -> b
$ \Source Text
src [Text]
_ -> case Source Text
src of
  User Text
n -> do
    Text
ver <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (InstanceConfig s) Text
version forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. IRC s (IRCState s)
getIRCState)
    forall s. Message Text -> IRC s ()
send forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> Message Text
ctcpReply Text
n Text
"VERSION" [Text
ver]
  Source Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Respond to CTCP @TIME@ requests with the system time.
ctcpTimeHandler :: EventHandler s
ctcpTimeHandler :: forall s. EventHandler s
ctcpTimeHandler = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (Text -> Event Text -> Maybe [Text]
matchCTCP Text
"TIME") forall a b. (a -> b) -> a -> b
$ \Source Text
src [Text]
_ -> case Source Text
src of
  User Text
n -> do
    UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    forall s. Message Text -> IRC s ()
send forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> Message Text
ctcpReply Text
n Text
"TIME" [String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%c" UTCTime
now]
  Source Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Update the nick upon welcome (numeric reply 001), as it may not
-- be what we requested (eg, in the case of a nick too long).
welcomeNick :: EventHandler s
welcomeNick :: forall s. EventHandler s
welcomeNick = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
001) forall a b. (a -> b) -> a -> b
$ \Source Text
_ [Text]
args -> case [Text]
args of
  (Text
srvNick:[Text]
_) -> do
    TVar (InstanceConfig s)
tvarI <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s (IRCState s)
getIRCState
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$
      forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI (forall s a. Lens' s a -> a -> s -> s
set forall s. Lens' (InstanceConfig s) Text
nick Text
srvNick)
  [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Join default channels upon welcome (numeric reply 001). If sent earlier,
-- the server might reject the JOIN attempts.
joinOnWelcome :: EventHandler s
joinOnWelcome :: forall s. EventHandler s
joinOnWelcome = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
001) forall a b. (a -> b) -> a -> b
$ \Source Text
_ [Text]
_ -> do
  InstanceConfig s
iconf <- forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. IRC s (IRCState s)
getIRCState
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s. Message Text -> IRC s ()
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NickName a -> Message (NickName a)
Join) forall a b. (a -> b) -> a -> b
$ forall a s. Getting a s a -> s -> a
get forall s. Lens' (InstanceConfig s) [Text]
channels InstanceConfig s
iconf

-- | Mangle the nick if there's a collision (numeric replies 432, 433,
-- and 436) when we set it
nickMangler :: EventHandler s
nickMangler :: forall s. EventHandler s
nickMangler = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (\Event Text
ev -> forall {a} {a}. Int -> a -> Event a -> Maybe (a, [a])
matcher Int
432 Text -> Text
fresh Event Text
ev forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}. Int -> a -> Event a -> Maybe (a, [a])
matcher Int
433 Text -> Text
mangle Event Text
ev forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}. Int -> a -> Event a -> Maybe (a, [a])
matcher Int
436 Text -> Text
mangle Event Text
ev) forall a b. (a -> b) -> a -> b
$ \Source Text
_ -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry 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 forall a. Event a -> Message a
_message Event a
ev of
      Numeric Int
n [a]
args | Int
num forall a. Eq a => a -> a -> Bool
== Int
n -> forall a. a -> Maybe a
Just (a
f, [a]
args)
      Message a
_ -> forall a. Maybe a
Nothing

    go :: (Text -> Text) -> [Text] -> IRC s ()
go Text -> Text
f (Text
_:Text
srvNick:[Text]
_) = do
      Text
theNick <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (InstanceConfig s) Text
nick forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a s.
MonadIO m =>
Getting (TVar a) s (TVar a) -> s -> m a
snapshot forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. IRC s (IRCState s)
getIRCState)

      -- If the length of our nick and the server's idea of our nick
      -- differ, it was truncated - so calculate the allowable length.
      let nicklen :: Maybe Int
nicklen = if Text -> Int
T.length Text
srvNick forall a. Eq a => a -> a -> Bool
/= Text -> Int
T.length Text
theNick
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
srvNick
                    else forall a. Maybe a
Nothing

      forall s. Text -> IRC s ()
setNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Text -> Text
trunc Maybe Int
nicklen forall a b. (a -> b) -> a -> b
$ Text -> Text
f Text
srvNick
    go Text -> Text
_ [Text]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

    fresh :: Text -> Text
fresh Text
n = if Text -> Int
T.length Text
n' 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 forall a. Semigroup a => a -> a -> a
<> Text
"1") forall a. a -> Maybe a -> a
`fromMaybe` Text -> Maybe Text
charsubst Text
n

    -- Truncate a nick, if there is a known length limit.
    trunc :: Maybe Int -> Text -> Text
trunc Maybe Int
len Text
txt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
txt (Int -> Text -> Text
`takeEnd` Text
txt) Maybe Int
len

    -- List of substring substitutions. It's important that these
    -- don't contain any loops!
    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
"-")
                          ]

    -- Attempt to transform some text by the substitutions.
    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) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
before forall a. Semigroup a => a -> a -> a
<> Text
to 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
_ = forall a. Maybe a
Nothing

-- | Upon joining a channel (numeric reply 331 or 332), add it to the
-- list (if not already present).
joinHandler :: EventHandler s
joinHandler :: forall s. EventHandler s
joinHandler = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (\Event Text
ev -> forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
331 Event Text
ev forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Int -> Event a -> Maybe [a]
matchNumeric Int
332 Event Text
ev) forall a b. (a -> b) -> a -> b
$ \Source Text
_ [Text]
args -> case [Text]
args of
  (Text
c:[Text]
_) -> do
    TVar (InstanceConfig s)
tvarI <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s (IRCState s)
getIRCState
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$
      forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI forall a b. (a -> b) -> a -> b
$ \InstanceConfig s
iconf ->
        (if Text
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a s. Getting a s a -> s -> a
get forall s. Lens' (InstanceConfig s) [Text]
channels InstanceConfig s
iconf
          then forall s a. Lens' s a -> (a -> a) -> s -> s
modify forall s. Lens' (InstanceConfig s) [Text]
channels (Text
cforall a. a -> [a] -> [a]
:)
          else forall a. a -> a
id) InstanceConfig s
iconf
  [Text]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Update the channel list upon being kicked.
kickHandler :: EventHandler s
kickHandler :: forall s. EventHandler s
kickHandler = forall b s.
(Event Text -> Maybe b)
-> (Source Text -> b -> IRC s ()) -> EventHandler s
EventHandler (forall a b. Prism' (Message a) b -> Event a -> Maybe b
matchType forall a. Prism' (Message a) (a, a, Reason a)
_Kick) forall a b. (a -> b) -> a -> b
$ \Source Text
src (Text
n, Text
_, Maybe Text
_) -> do
  TVar (InstanceConfig s)
tvarI <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s (IRCState s)
getIRCState
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
    Text
theNick <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (InstanceConfig s) Text
nick forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TVar a -> STM a
readTVar TVar (InstanceConfig s)
tvarI
    case Source Text
src of
      Channel Text
c Text
_
        | Text
n forall a. Eq a => a -> a -> Bool
== Text
theNick -> forall s. TVar (InstanceConfig s) -> Text -> STM ()
delChan TVar (InstanceConfig s)
tvarI Text
c
        | Bool
otherwise    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Source Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-------------------------------------------------------------------------------
-- Utils

-- | Break some text on the first occurrence of a substring, removing
-- the substring from the second portion.
breakOn' :: Text -> Text -> Maybe (Text, Text)
breakOn' :: Text -> Text -> Maybe (Text, Text)
breakOn' Text
delim Text
txt = if Text -> Int
T.length Text
after forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
delim
                     then forall a. a -> Maybe a
Just (Text
before, Int -> Text -> Text
T.drop (Text -> Int
T.length Text
delim) Text
after)
                     else forall a. Maybe a
Nothing
  where
    (Text
before, Text
after) = Text -> Text -> (Text, Text)
breakOn Text
delim Text
txt