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
|
--
-- Provides interface to messages, message pipes
--
module Message(Message(..), Nick(..), showNick, readNick, Pipe, packNick, unpackNick) where
import qualified Data.ByteString.Char8 as P
import Control.Concurrent (Chan)
import Data.Char (toUpper)
import Control.Arrow (first)
-- TODO: probably remove "Show a" later
class Show a => Message a where
-- | extracts the tag of the server involved in a given message
server :: a -> String
-- | extracts the nickname involved in a given message.
nick :: a -> Nick
-- | 'fullName' extracts the full user name involved in a given message.
fullName :: a -> String
-- | 'names' builds a NAMES message from a list of channels.
names :: String -> [String] -> a
-- | 'channels' extracts the channels a Message operate on.
channels :: a -> [Nick]
-- | 'join' creates a join message. String given is the location (channel) to join
joinChannel :: Nick -> a
-- | 'part' parts the channel given.
partChannel :: Nick -> a
-- | 'getTopic' Returns the topic for a channel, given as a String
getTopic :: Nick -> a
-- | 'setTopic' takes a channel and a topic. It then returns the message
-- which sets the channels topic.
setTopic :: Nick -> String -> a
-- TODO: recheck this. It's usage heavily relies on the fact that message comes from IRC
body :: a -> [String]
-- TODO: too IRC-specific
command :: a -> String
-- TODO: there must be a better way of handling this ...
lambdabotName :: a -> Nick
-- | The type of nicknames isolated from a message.
data Nick
= Nick {
nTag :: !String, -- ^The tag of the server this nick is on
nName :: !String -- ^The server-specific nickname of this nick
}
-- This definition of canonicalizeName breaks strict RFC rules, but so does
-- freenode
canonicalizeName :: String -> String
canonicalizeName = map toUpper
instance Eq Nick where
(Nick tag name) == (Nick tag2 name2) =
(canonicalizeName name == canonicalizeName name2) && (tag == tag2)
instance Ord Nick where
(Nick tag name) <= (Nick tag2 name2) =
(tag, canonicalizeName name) <= (tag2, canonicalizeName name2)
-- Helper functions
upckStr :: String -> String -> Nick
upckStr def str | null ac = Nick def str
| otherwise = Nick bc (tail ac)
where (bc, ac) = break (==':') str
pckStr :: Nick -> String
pckStr nck = nTag nck ++ ':' : nName nck
-- | Format a nickname for display. This will automatically omit the server
-- field if it is the same as the server of the provided message.
showNick :: Message a => a -> Nick -> String
showNick msg nick_ | nTag nick_ == server msg = nName nick_
| otherwise = pckStr nick_
-- | Parse a nickname received in a message. If the server field is not
-- provided, it defaults to the same as that of the message.
readNick :: Message a => a -> String -> Nick
readNick msg str = upckStr (server msg) str'
where str' | last str `elem` ":" = init str
| otherwise = str
instance Show Nick where
show x | nTag x == "freenode" = show $ nName x
| otherwise = show $ pckStr x
instance Read Nick where
readsPrec prec str = map (first (upckStr "freenode")) (readsPrec prec str)
-- | Pack a nickname into a ByteString. Note that the resulting strings are
-- not optimally formatted for human consumtion.
packNick :: Nick -> P.ByteString
packNick = P.pack . pckStr
-- | Unpack a nickname packed by 'packNick'.
unpackNick :: P.ByteString -> Nick
unpackNick = upckStr "freenode" . P.unpack
type Pipe a = Chan (Maybe a)
|
