1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
-- |
-- Module : Network.IRC.Client.Utils
-- Copyright : (c) 2016 Michael Walker
-- License : MIT
-- Maintainer : Michael Walker <mike@barrucadu.co.uk>
-- Stability : experimental
-- Portability : portable
--
-- Commonly-used utility functions for IRC clients.
module Network.IRC.Client.Utils
( -- * Nicks
setNick
-- * Channels
, leaveChannel
, delChan
-- * Events
, addHandler
, reply
, replyTo
-- * CTCPs
, ctcp
, ctcpReply
-- * Connection state
, isConnected
, isDisconnecting
, isDisconnected
, snapConnState
-- * Concurrency
, fork
-- * Lenses
, snapshot
, snapshotModify
, get
, set
, modify
) where
import Control.Concurrent (ThreadId, forkFinally, myThreadId)
import Control.Concurrent.STM (STM, TVar, atomically, modifyTVar)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Network.IRC.Conduit (Event(..), Message(..),
Source(..))
import Network.IRC.CTCP (toCTCP)
import Network.IRC.Client.Internal
import Network.IRC.Client.Lens
-------------------------------------------------------------------------------
-- Nicks
-- | Update the nick in the instance configuration and also send an
-- update message to the server. This doesn't attempt to resolve nick
-- collisions, that's up to the event handlers.
setNick :: Text -> IRC s ()
setNick new = do
tvarI <- get instanceConfig <$> getIRCState
liftIO . atomically $
modifyTVar tvarI (set nick new)
send $ Nick new
-------------------------------------------------------------------------------
-- Channels
-- | Update the channel list in the instance configuration and also
-- part the channel.
leaveChannel :: Text -> Maybe Text -> IRC s ()
leaveChannel chan reason = do
tvarI <- get instanceConfig <$> getIRCState
liftIO . atomically $ delChan tvarI chan
send $ Part chan reason
-- | Remove a channel from the list without sending a part command (be
-- careful not to let the channel list get out of sync with the
-- real-world state if you use it for anything!)
delChan :: TVar (InstanceConfig s) -> Text -> STM ()
delChan tvarI chan =
modifyTVar tvarI (modify channels (filter (/=chan)))
-------------------------------------------------------------------------------
-- Events
-- | Add an event handler
addHandler :: EventHandler s -> IRC s ()
addHandler handler = do
tvarI <- get instanceConfig <$> getIRCState
liftIO . atomically $
modifyTVar tvarI (modify handlers (handler:))
-- | Send a message to the source of an event.
reply :: Event Text -> Text -> IRC s ()
reply = replyTo . _source
-- | Send a message to the source of an event.
replyTo :: Source Text -> Text -> IRC s ()
replyTo (Channel c _) = mapM_ (send . Privmsg c . Right) . T.lines
replyTo (User n) = mapM_ (send . Privmsg n . Right) . T.lines
replyTo _ = const $ pure ()
-------------------------------------------------------------------------------
-- CTCPs
-- | Construct a @PRIVMSG@ containing a CTCP
ctcp :: Text -> Text -> [Text] -> Message Text
ctcp t command args = Privmsg t . Left $ toCTCP command args
-- | Construct a @NOTICE@ containing a CTCP
ctcpReply :: Text -> Text -> [Text] -> Message Text
ctcpReply t command args = Notice t . Left $ toCTCP command args
-------------------------------------------------------------------------------
-- Connection state
-- | Check if the client is connected.
isConnected :: IRC s Bool
isConnected = (==Connected) <$> snapConnState
-- | Check if the client is in the process of disconnecting.
isDisconnecting :: IRC s Bool
isDisconnecting = (==Disconnecting) <$> snapConnState
-- | Check if the client is disconnected
isDisconnected :: IRC s Bool
isDisconnected = (==Disconnected) <$> snapConnState
-- | Snapshot the connection state.
snapConnState :: IRC s ConnectionState
snapConnState = liftIO . atomically . getConnectionState =<< getIRCState
-------------------------------------------------------------------------------
-- Concurrency
-- | Fork a thread which will be thrown a 'Disconnect' exception when
-- the client disconnects.
fork :: IRC s () -> IRC s ThreadId
fork ma = do
s <- getIRCState
liftIO $ do
tid <- forkFinally (runIRCAction ma s) $ \_ -> do
tid <- myThreadId
atomically $ modifyTVar (_runningThreads s) (S.delete tid)
atomically $ modifyTVar (_runningThreads s) (S.insert tid)
pure tid
|
