{-# Language TemplateHaskell #-}
module Client.State.Channel
(
ChannelState(..)
, chanTopic
, chanTopicProvenance
, chanUrl
, chanUsers
, chanModes
, chanLists
, chanCreation
, chanQueuedModeration
, MaskListEntry(..)
, maskListSetter
, maskListTime
, TopicProvenance(..)
, topicAuthor
, topicTime
, newChannel
, setTopic
, joinChannel
, partChannel
, nickChange
) where
import Control.Lens
import Data.HashMap.Strict
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time
import Irc.Identifier
import Irc.RawIrcMsg (RawIrcMsg)
import Irc.UserInfo
data ChannelState = ChannelState
{ _chanTopic :: !Text
, _chanTopicProvenance :: !(Maybe TopicProvenance)
, _chanUrl :: !(Maybe Text)
, _chanUsers :: !(HashMap Identifier String)
, _chanModes :: !(Map Char Text)
, _chanLists :: !(Map Char (HashMap Text MaskListEntry))
, _chanCreation :: !(Maybe UTCTime)
, _chanQueuedModeration :: ![RawIrcMsg]
}
deriving Show
data TopicProvenance = TopicProvenance
{ _topicAuthor :: !UserInfo
, _topicTime :: !UTCTime
}
deriving Show
data MaskListEntry = MaskListEntry
{ _maskListSetter :: {-# UNPACK #-} !Text
, _maskListTime :: {-# UNPACK #-} !UTCTime
}
deriving Show
makeLenses ''ChannelState
makeLenses ''TopicProvenance
makeLenses ''MaskListEntry
newChannel :: ChannelState
newChannel = ChannelState
{ _chanTopic = Text.empty
, _chanUrl = Nothing
, _chanTopicProvenance = Nothing
, _chanUsers = HashMap.empty
, _chanModes = Map.empty
, _chanLists = Map.empty
, _chanCreation = Nothing
, _chanQueuedModeration = []
}
joinChannel :: Identifier -> ChannelState -> ChannelState
joinChannel nick = set (chanUsers . at nick) (Just "")
partChannel :: Identifier -> ChannelState -> ChannelState
partChannel = over chanUsers . sans
nickChange :: Identifier -> Identifier -> ChannelState -> ChannelState
nickChange fromNick toNick cs =
set (chanUsers . at toNick) modes cs'
where
(modes, cs') = cs & chanUsers . at fromNick <<.~ Nothing
setTopic :: Text -> ChannelState -> ChannelState
setTopic = set chanTopic