{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
module Network.Yak.Client
(
Authenticate,
authenticateArgument,
Pass,
passPassword,
Nick,
nickNickname,
User,
userUsername,
userMode,
userUnused,
userRealname,
Oper,
operName,
operPassword,
Quit,
quitMessage,
Join,
Join0,
joinChannels,
joinKeys,
Part,
partChannels,
partMessage,
Topic,
topicChannel,
topicMessage,
Names,
namesChannels,
List,
listChannels,
listElistCond,
Motd,
motdTarget,
Lusers,
lusersParam,
lusersMask,
lusersTarget,
Version,
versionTarget,
Admin,
adminTarget,
Connect,
connectTarget,
connectConnInfo,
Time,
timeTarget,
Stats,
statsQuery,
statsTarget,
Info,
infoTarget,
Mode,
modeTarget,
modeSetter,
modeChannel,
modeNick,
modeString,
Privmsg,
privmsgTargets,
privmsgMessage,
privmsgChannel,
privmsgNick,
Notice,
noticeTargets,
noticeMessage,
noticeChannel,
noticeNick,
Who,
whoMask,
whoFlag,
WhoIs,
whoIsTarget,
whoIsMasks,
WhoWas,
whoWasNicks,
whoWasParam,
whoWasCount,
whoWasTarget,
Userhost,
userhostNick1,
userhostNick2,
userhostNick3,
userhostNick4,
userhostNick5,
Ping,
pingServer1,
pingServer2,
Pong,
pongServer1,
pongServer2,
Kill,
killNick,
killMessage,
Kick,
kickChannels,
kickNicknames,
kickMessage,
Invite,
inviteNickname,
inviteChannel,
HasChannel(..),
HasNick(..),
HasHostname(..)
)
where
import Control.Lens
import Data.ByteString.Char8 (ByteString)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Word (Word)
import Network.Yak.TH
import Network.Yak.Types
import Network.Yak.Modes (ServerModes, ModeStr, fetchModeStr)
type Authenticate = Msg "AUTHENTICATE" '[Text]
makeMsgLenses ''Authenticate ["argument"]
type Pass = Msg "PASS" '[Text]
makeMsgLenses ''Pass ["password"]
type Nick = Msg "NICK" '[Nickname]
makeMsgLenses ''Nick ["nickname"]
type User = Msg "USER" '[Username, Word, Unused "*", Message]
makeMsgLenses ''User ["username", "mode", "unused", "realname"]
type Oper = Msg "OPER" '[Nickname, Text]
makeMsgLenses ''Oper ["name", "password"]
type Quit = Msg "QUIT" '[Message]
makeMsgLenses ''Quit ["message"]
type Join = Msg "JOIN" '[NonEmpty Channel, [Text]]
type Join0 = Msg "JOIN" '[Unused "0"]
makeMsgLenses ''Join ["channels", "keys"]
type Part = Msg "PART" '[NonEmpty Channel, Maybe Message]
makeMsgLenses ''Part ["channels", "message"]
type Topic = Msg "TOPIC" '[Channel, Maybe Message]
makeMsgLenses ''Topic ["channel", "message"]
type Names = Msg "NAMES" '[[Channel]]
makeMsgLenses ''Names ["channels"]
type List = Msg "LIST" '[[Channel], Maybe Text]
makeMsgLenses ''List ["channels", "elistCond"]
type Motd = Msg "MOTD" '[Hostname]
makeMsgLenses ''Motd ["target"]
type Lusers = Msg "LUSERS" '[Maybe (Mask, Maybe Hostname)]
makeMsgLenses ''Lusers ["param"]
lusersMask :: Traversal' Lusers Mask
lusersMask = lusersParam . _Just . _1
lusersTarget :: Traversal' Lusers Hostname
lusersTarget = lusersParam . _Just . _2 . _Just
type Version = Msg "VERSION" '[Maybe Hostname]
makeMsgLenses ''Version ["target"]
type Admin = Msg "ADMIN" '[Maybe Hostname]
makeMsgLenses ''Admin ["target"]
type Connect = Msg "CONNECT" '[Hostname, Maybe (Int, Maybe Hostname)]
makeMsgLenses ''Connect ["target", "connInfo"]
type Time = Msg "TIME" '[Maybe Hostname]
makeMsgLenses ''Time ["target"]
type Stats = Msg "STATS" '[Char, Maybe Hostname]
makeMsgLenses ''Stats ["query", "target"]
type Info = Msg "INFO" '[Maybe Hostname]
makeMsgLenses ''Info ["target"]
type Mode = Msg "MODE"
'[Either Channel Nickname, Maybe ByteString]
makeMsgLenses ''Mode ["target", "setter"]
modeChannel :: Traversal' Mode Channel
modeChannel = modeTarget . _Left
modeNick :: Traversal' Mode Nickname
modeNick = modeTarget . _Right
modeString :: ServerModes -> Fold Mode ModeStr
modeString m = modeSetter . _Just . to (fetchModeStr m) . _Just
type Privmsg = Msg "PRIVMSG" '[NonEmpty (Either Channel Nickname), Message]
makeMsgLenses ''Privmsg ["targets", "message"]
privmsgChannel :: Traversal' Privmsg Channel
privmsgChannel = privmsgTargets . traverse . _Left
privmsgNick :: Traversal' Privmsg Nickname
privmsgNick = privmsgTargets . traverse . _Right
type Notice = Msg "NOTICE" '[NonEmpty (Either Channel Nickname), Message]
makeMsgLenses ''Notice ["targets", "message"]
noticeChannel :: Traversal' Notice Channel
noticeChannel = noticeTargets . traverse . _Left
noticeNick :: Traversal' Notice Nickname
noticeNick = noticeTargets . traverse . _Right
type Who = Msg "WHO" '[Maybe Mask, Flag "o"]
makeMsgLenses ''Who ["mask", "flag"]
type WhoIs = Msg "WHOIS" '[Maybe Hostname, NonEmpty Mask]
makeMsgLenses ''WhoIs ["target", "masks"]
type WhoWas = Msg "WHOWAS" '[NonEmpty Nickname, Maybe (Int, Maybe Hostname)]
makeMsgLenses ''WhoWas ["nicks", "param"]
whoWasCount :: Traversal' WhoWas Int
whoWasCount = whoWasParam . _Just . _1
whoWasTarget :: Traversal' WhoWas Hostname
whoWasTarget = whoWasParam . _Just . _2 . _Just
type Userhost = Msg "USERHOST"
'[Nickname, Maybe Nickname, Maybe Nickname, Maybe Nickname, Maybe Nickname]
makeMsgLenses ''Userhost ["nick1", "nick2", "nick3", "nick4", "nick5"]
type Ping = Msg "PING" '[Hostname, Maybe Hostname]
makeMsgLenses ''Ping ["server1", "server2"]
type Pong = Msg "PONG" '[Hostname, Maybe Hostname]
makeMsgLenses ''Pong ["server1", "server2"]
type Kill = Msg "KILL" '[Nickname, Message]
makeMsgLenses ''Kill ["nick", "message"]
type Kick = Msg "KICK" '[NonEmpty Channel, NonEmpty Nickname, Maybe Message]
makeMsgLenses ''Kick ["channels", "nicknames", "message"]
type Invite = Msg "INVITE" '[Nickname, Channel]
makeMsgLenses ''Invite ["nickname", "channel"]
class HasChannel a where
channel :: Traversal' a Channel
instance HasChannel Join where
channel = joinChannels . traverse
instance HasChannel Part where
channel = partChannels . traverse
instance HasChannel Topic where
channel = topicChannel
instance HasChannel Names where
channel = namesChannels . traverse
instance HasChannel List where
channel = listChannels . traverse
instance HasChannel Privmsg where
channel = privmsgChannel
instance HasChannel Mode where
channel = modeChannel
instance HasChannel Notice where
channel = noticeChannel
instance HasChannel Kick where
channel = kickChannels . traverse
instance HasChannel Invite where
channel = inviteChannel
class HasNick a where
nick :: Traversal' a Nickname
instance HasNick Nick where
nick = nickNickname
instance HasNick Oper where
nick = operName
instance HasNick Mode where
nick = modeNick
instance HasNick Privmsg where
nick = privmsgNick
instance HasNick Notice where
nick = noticeNick
instance HasNick WhoWas where
nick = whoWasNicks . traverse
instance HasNick Kill where
nick = killNick
instance HasNick Kick where
nick = kickNicknames . traverse
instance HasNick Invite where
nick = inviteNickname
class HasHostname a where
hostname :: Traversal' a Hostname
instance HasHostname Motd where
hostname = motdTarget
instance HasHostname Lusers where
hostname = lusersTarget
instance HasHostname Version where
hostname = versionTarget . _Just
instance HasHostname Admin where
hostname = adminTarget . _Just
instance HasHostname Time where
hostname = timeTarget . _Just
instance HasHostname Stats where
hostname = statsTarget . _Just
instance HasHostname Info where
hostname = infoTarget . _Just
instance HasHostname WhoIs where
hostname = whoIsTarget . _Just
instance HasHostname WhoWas where
hostname = whoWasTarget