pinealservo
/
pipes-irc-server
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Got rid of ! in Server.hs via better lensing

master
Levi Pearson 2014-06-29 23:50:26 -06:00
parent fd141d09fb
commit f8b361dc5b
1 changed files with 12 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Pipes/IRC/Server/Server.hs
View File

@ -20,11 +20,9 @@ module Pipes.IRC.Server.Server
where where
import Control.Lens import Control.Lens
import Data.Map ((!))
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import qualified Data.Set as S import qualified Data.Set as S
import Pipes.IRC.Server.Channel import Pipes.IRC.Server.Channel
import Pipes.IRC.Server.Types import Pipes.IRC.Server.Types
import Pipes.IRC.Server.User import Pipes.IRC.Server.User
@ -46,14 +44,14 @@ ircDelUser :: NickKey -- ^ nickname of the user to delete
-> IrcServer -- ^ server to delete the user from -> IrcServer -- ^ server to delete the user from
-> IrcServer -- ^ new server with user deleted -> IrcServer -- ^ new server with user deleted
ircDelUser nn srv = ircDelUser nn srv =
srv & ircNicks %~ S.delete nn srv & ircNicks %~ sans nn
& if M.notMember nn (srv ^. ircUsers) then id else & if isn't _Just (srv ^. ircUsers . at nn) then id else
let let
usr = (srv ^. ircUsers) ! nn usr = srv ^. ircUsers . at nn
uchans = S.elems (usr ^. userChannels) uchans = usr ^. traverse . userChannels . to S.elems
ichans = S.elems (usr ^. userInvites) ichans = usr ^. traverse . userInvites . to S.elems
in in
(ircUsers %~ M.delete nn) (ircUsers %~ sans nn)
. (ircChannels %~ alterAtKeys (ircPartChan nn) uchans) . (ircChannels %~ alterAtKeys (ircPartChan nn) uchans)
. (ircChannels %~ adjustAtKeys (chanDelInvite nn) ichans) . (ircChannels %~ adjustAtKeys (chanDelInvite nn) ichans)
@ -105,8 +103,8 @@ ircPart uname cn srv =
srv & (ircChannels %~ (M.alter $ ircPartChan uname) cn) srv & (ircChannels %~ (M.alter $ ircPartChan uname) cn)
& (ircUsers %~ adjustAtKeys (userDelInvite cn) iusers) & (ircUsers %~ adjustAtKeys (userDelInvite cn) iusers)
where where
chan = (srv ^. ircChannels) ! cn chan = srv ^. ircChannels . at cn
iusers = S.elems $ chan ^. chanInvites iusers = chan ^. traverse . chanInvites . to S.elems
-- | Add the user with the given nickname to the invited list for the -- | Add the user with the given nickname to the invited list for the
-- channel, and add the channel to the user's invited list. -- channel, and add the channel to the user's invited list.
@ -146,9 +144,9 @@ ircChangeNick old new srv =
if M.notMember old (srv ^. ircUsers) then if M.notMember old (srv ^. ircUsers) then
srv srv
else let else let
usr = (srv ^. ircUsers) ! old usr = srv ^. ircUsers . at old
chs = S.elems (usr ^. userChannels) chs = usr ^. traverse . userChannels . to S.elems
in in
srv & (ircNicks %~ S.delete old . S.insert new) srv & (ircNicks %~ sans old . S.insert new)
& (ircUsers %~ M.delete old . M.insert new usr) & (ircUsers %~ sans old . (at new .~ usr))
& (ircChannels %~ adjustAtKeys (chanChangeNick old new) chs) & (ircChannels %~ adjustAtKeys (chanChangeNick old new) chs)