{-# 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 ((&), sans, (<<.~), over, set, makeLenses, At(at))
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (UTCTime)
import Irc.Identifier (Identifier)
import Irc.RawIrcMsg (RawIrcMsg)
import Irc.UserInfo (UserInfo)
data ChannelState = ChannelState
{ ChannelState -> Text
_chanTopic :: !Text
, ChannelState -> Maybe TopicProvenance
_chanTopicProvenance :: !(Maybe TopicProvenance)
, ChannelState -> Maybe Text
_chanUrl :: !(Maybe Text)
, ChannelState -> HashMap Identifier String
_chanUsers :: !(HashMap Identifier String)
, ChannelState -> Map Char Text
_chanModes :: !(Map Char Text)
, ChannelState -> Map Char (HashMap Text MaskListEntry)
_chanLists :: !(Map Char (HashMap Text MaskListEntry))
, ChannelState -> Maybe UTCTime
_chanCreation :: !(Maybe UTCTime)
, ChannelState -> [RawIrcMsg]
_chanQueuedModeration :: ![RawIrcMsg]
}
deriving Int -> ChannelState -> ShowS
[ChannelState] -> ShowS
ChannelState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelState] -> ShowS
$cshowList :: [ChannelState] -> ShowS
show :: ChannelState -> String
$cshow :: ChannelState -> String
showsPrec :: Int -> ChannelState -> ShowS
$cshowsPrec :: Int -> ChannelState -> ShowS
Show
data TopicProvenance = TopicProvenance
{ TopicProvenance -> UserInfo
_topicAuthor :: !UserInfo
, TopicProvenance -> UTCTime
_topicTime :: !UTCTime
}
deriving Int -> TopicProvenance -> ShowS
[TopicProvenance] -> ShowS
TopicProvenance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopicProvenance] -> ShowS
$cshowList :: [TopicProvenance] -> ShowS
show :: TopicProvenance -> String
$cshow :: TopicProvenance -> String
showsPrec :: Int -> TopicProvenance -> ShowS
$cshowsPrec :: Int -> TopicProvenance -> ShowS
Show
data MaskListEntry = MaskListEntry
{ MaskListEntry -> Text
_maskListSetter :: {-# UNPACK #-} !Text
, MaskListEntry -> UTCTime
_maskListTime :: {-# UNPACK #-} !UTCTime
}
deriving Int -> MaskListEntry -> ShowS
[MaskListEntry] -> ShowS
MaskListEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaskListEntry] -> ShowS
$cshowList :: [MaskListEntry] -> ShowS
show :: MaskListEntry -> String
$cshow :: MaskListEntry -> String
showsPrec :: Int -> MaskListEntry -> ShowS
$cshowsPrec :: Int -> MaskListEntry -> ShowS
Show
makeLenses ''ChannelState
makeLenses ''TopicProvenance
makeLenses ''MaskListEntry
newChannel :: ChannelState
newChannel :: ChannelState
newChannel = ChannelState
{ _chanTopic :: Text
_chanTopic = Text
Text.empty
, _chanUrl :: Maybe Text
_chanUrl = forall a. Maybe a
Nothing
, _chanTopicProvenance :: Maybe TopicProvenance
_chanTopicProvenance = forall a. Maybe a
Nothing
, _chanUsers :: HashMap Identifier String
_chanUsers = forall k v. HashMap k v
HashMap.empty
, _chanModes :: Map Char Text
_chanModes = forall k a. Map k a
Map.empty
, _chanLists :: Map Char (HashMap Text MaskListEntry)
_chanLists = forall k a. Map k a
Map.empty
, _chanCreation :: Maybe UTCTime
_chanCreation = forall a. Maybe a
Nothing
, _chanQueuedModeration :: [RawIrcMsg]
_chanQueuedModeration = []
}
joinChannel :: Identifier -> ChannelState -> ChannelState
joinChannel :: Identifier -> ChannelState -> ChannelState
joinChannel Identifier
nick = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' ChannelState (HashMap Identifier String)
chanUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
nick) (forall a. a -> Maybe a
Just String
"")
partChannel :: Identifier -> ChannelState -> ChannelState
partChannel :: Identifier -> ChannelState -> ChannelState
partChannel = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ChannelState (HashMap Identifier String)
chanUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> m -> m
sans
nickChange :: Identifier -> Identifier -> ChannelState -> ChannelState
nickChange :: Identifier -> Identifier -> ChannelState -> ChannelState
nickChange Identifier
fromNick Identifier
toNick ChannelState
cs =
forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' ChannelState (HashMap Identifier String)
chanUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
toNick) Maybe String
modes ChannelState
cs'
where
(Maybe String
modes, ChannelState
cs') = ChannelState
cs forall a b. a -> (a -> b) -> b
& Lens' ChannelState (HashMap Identifier String)
chanUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
fromNick forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ forall a. Maybe a
Nothing
setTopic :: Text -> ChannelState -> ChannelState
setTopic :: Text -> ChannelState -> ChannelState
setTopic = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ChannelState Text
chanTopic