{-# Language TemplateHaskell #-}

{-|
Module      : Client.State.Channel
Description : IRC channel session state
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module is responsible for tracking the state of an individual IRC
channel while the client is connected to it. When the client joins a
channel a new channel session is created and when the client leaves
a channel is it destroyed.
-}

module Client.State.Channel
  (
  -- * Channel state
    ChannelState(..)
  , chanCreation
  , chanJoined
  , chanLists
  , chanModes
  , chanQueuedModeration
  , chanTopic
  , chanTopicProvenance
  , chanUrl
  , chanUsers

  -- * Mask list entries
  , MaskListEntry(..)
  , maskListSetter
  , maskListTime

  -- * Topic information
  , TopicProvenance(..)
  , topicAuthor
  , topicTime

  -- * Channel manipulation
  , 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)

-- | Dynamic information about the state of an IRC channel
data ChannelState = ChannelState
  { ChannelState -> Bool
_chanJoined :: !Bool
        -- ^ client is currently connected to this channel
  , ChannelState -> Text
_chanTopic :: !Text
        -- ^ topic text
  , ChannelState -> Maybe TopicProvenance
_chanTopicProvenance :: !(Maybe TopicProvenance)
        -- ^ author and timestamp for topic
  , ChannelState -> Maybe Text
_chanUrl :: !(Maybe Text)
        -- ^ channel URL
  , ChannelState -> HashMap Identifier String
_chanUsers :: !(HashMap Identifier String)
        -- ^ user list and sigils
  , ChannelState -> Map Char Text
_chanModes :: !(Map Char Text)
        -- ^ channel settings and parameters
  , ChannelState -> Map Char (HashMap Text MaskListEntry)
_chanLists :: !(Map Char (HashMap Text MaskListEntry))
        -- ^ mode, mask, setter, set time
  , ChannelState -> Maybe UTCTime
_chanCreation :: !(Maybe UTCTime) -- ^ creation time of channel
  , ChannelState -> [RawIrcMsg]
_chanQueuedModeration :: ![RawIrcMsg] -- ^ delayed op messages
  }
  deriving Int -> ChannelState -> ShowS
[ChannelState] -> ShowS
ChannelState -> String
(Int -> ChannelState -> ShowS)
-> (ChannelState -> String)
-> ([ChannelState] -> ShowS)
-> Show ChannelState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChannelState -> ShowS
showsPrec :: Int -> ChannelState -> ShowS
$cshow :: ChannelState -> String
show :: ChannelState -> String
$cshowList :: [ChannelState] -> ShowS
showList :: [ChannelState] -> ShowS
Show

data TopicProvenance = TopicProvenance
  { TopicProvenance -> UserInfo
_topicAuthor :: !UserInfo
  , TopicProvenance -> UTCTime
_topicTime   :: !UTCTime
  }
  deriving Int -> TopicProvenance -> ShowS
[TopicProvenance] -> ShowS
TopicProvenance -> String
(Int -> TopicProvenance -> ShowS)
-> (TopicProvenance -> String)
-> ([TopicProvenance] -> ShowS)
-> Show TopicProvenance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TopicProvenance -> ShowS
showsPrec :: Int -> TopicProvenance -> ShowS
$cshow :: TopicProvenance -> String
show :: TopicProvenance -> String
$cshowList :: [TopicProvenance] -> ShowS
showList :: [TopicProvenance] -> ShowS
Show

data MaskListEntry = MaskListEntry
  { MaskListEntry -> Text
_maskListSetter :: {-# UNPACK #-} !Text
  , MaskListEntry -> UTCTime
_maskListTime   :: {-# UNPACK #-} !UTCTime
  }
  deriving Int -> MaskListEntry -> ShowS
[MaskListEntry] -> ShowS
MaskListEntry -> String
(Int -> MaskListEntry -> ShowS)
-> (MaskListEntry -> String)
-> ([MaskListEntry] -> ShowS)
-> Show MaskListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaskListEntry -> ShowS
showsPrec :: Int -> MaskListEntry -> ShowS
$cshow :: MaskListEntry -> String
show :: MaskListEntry -> String
$cshowList :: [MaskListEntry] -> ShowS
showList :: [MaskListEntry] -> ShowS
Show

makeLenses ''ChannelState
makeLenses ''TopicProvenance
makeLenses ''MaskListEntry

-- | Construct an empty 'ChannelState'
newChannel :: ChannelState
newChannel :: ChannelState
newChannel = ChannelState
  { _chanJoined :: Bool
_chanJoined = Bool
False
  , _chanTopic :: Text
_chanTopic = Text
Text.empty
  , _chanUrl :: Maybe Text
_chanUrl = Maybe Text
forall a. Maybe a
Nothing
  , _chanTopicProvenance :: Maybe TopicProvenance
_chanTopicProvenance = Maybe TopicProvenance
forall a. Maybe a
Nothing
  , _chanUsers :: HashMap Identifier String
_chanUsers = HashMap Identifier String
forall k v. HashMap k v
HashMap.empty
  , _chanModes :: Map Char Text
_chanModes = Map Char Text
forall k a. Map k a
Map.empty
  , _chanLists :: Map Char (HashMap Text MaskListEntry)
_chanLists = Map Char (HashMap Text MaskListEntry)
forall k a. Map k a
Map.empty
  , _chanCreation :: Maybe UTCTime
_chanCreation = Maybe UTCTime
forall a. Maybe a
Nothing
  , _chanQueuedModeration :: [RawIrcMsg]
_chanQueuedModeration = []
  }


-- | Add a user to the user list
joinChannel :: Identifier -> ChannelState -> ChannelState
joinChannel :: Identifier -> ChannelState -> ChannelState
joinChannel Identifier
nick = ASetter ChannelState ChannelState (Maybe String) (Maybe String)
-> Maybe String -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((HashMap Identifier String -> Identity (HashMap Identifier String))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (HashMap Identifier String)
chanUsers ((HashMap Identifier String
  -> Identity (HashMap Identifier String))
 -> ChannelState -> Identity ChannelState)
-> ((Maybe String -> Identity (Maybe String))
    -> HashMap Identifier String
    -> Identity (HashMap Identifier String))
-> ASetter ChannelState ChannelState (Maybe String) (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier String)
-> Lens'
     (HashMap Identifier String)
     (Maybe (IxValue (HashMap Identifier String)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier String)
nick) (String -> Maybe String
forall a. a -> Maybe a
Just String
"")

-- | Remove a user from the user list
partChannel :: Identifier -> ChannelState -> ChannelState
partChannel :: Identifier -> ChannelState -> ChannelState
partChannel = ((HashMap Identifier String
  -> Identity (HashMap Identifier String))
 -> ChannelState -> Identity ChannelState)
-> (HashMap Identifier String -> HashMap Identifier String)
-> ChannelState
-> ChannelState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (HashMap Identifier String -> Identity (HashMap Identifier String))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (HashMap Identifier String)
chanUsers ((HashMap Identifier String -> HashMap Identifier String)
 -> ChannelState -> ChannelState)
-> (Identifier
    -> HashMap Identifier String -> HashMap Identifier String)
-> Identifier
-> ChannelState
-> ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier
-> HashMap Identifier String -> HashMap Identifier String
Index (HashMap Identifier String)
-> HashMap Identifier String -> HashMap Identifier String
forall m. At m => Index m -> m -> m
sans

-- | Rename a user in the user list
nickChange :: Identifier -> Identifier -> ChannelState -> ChannelState
nickChange :: Identifier -> Identifier -> ChannelState -> ChannelState
nickChange Identifier
fromNick Identifier
toNick ChannelState
cs =
  ASetter ChannelState ChannelState (Maybe String) (Maybe String)
-> Maybe String -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((HashMap Identifier String -> Identity (HashMap Identifier String))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (HashMap Identifier String)
chanUsers ((HashMap Identifier String
  -> Identity (HashMap Identifier String))
 -> ChannelState -> Identity ChannelState)
-> ((Maybe String -> Identity (Maybe String))
    -> HashMap Identifier String
    -> Identity (HashMap Identifier String))
-> ASetter ChannelState ChannelState (Maybe String) (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier String)
-> Lens'
     (HashMap Identifier String)
     (Maybe (IxValue (HashMap Identifier String)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier String)
toNick) Maybe String
modes ChannelState
cs'
  where
  (Maybe String
modes, ChannelState
cs') = ChannelState
cs ChannelState
-> (ChannelState -> (Maybe String, ChannelState))
-> (Maybe String, ChannelState)
forall a b. a -> (a -> b) -> b
& (HashMap Identifier String
 -> (Maybe String, HashMap Identifier String))
-> ChannelState -> (Maybe String, ChannelState)
Lens' ChannelState (HashMap Identifier String)
chanUsers ((HashMap Identifier String
  -> (Maybe String, HashMap Identifier String))
 -> ChannelState -> (Maybe String, ChannelState))
-> ((Maybe String -> (Maybe String, Maybe String))
    -> HashMap Identifier String
    -> (Maybe String, HashMap Identifier String))
-> (Maybe String -> (Maybe String, Maybe String))
-> ChannelState
-> (Maybe String, ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier String)
-> Lens'
     (HashMap Identifier String)
     (Maybe (IxValue (HashMap Identifier String)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier String)
fromNick ((Maybe String -> (Maybe String, Maybe String))
 -> ChannelState -> (Maybe String, ChannelState))
-> Maybe String -> ChannelState -> (Maybe String, ChannelState)
forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ Maybe String
forall a. Maybe a
Nothing

-- | Set the channel topic
setTopic :: Text -> ChannelState -> ChannelState
setTopic :: Text -> ChannelState -> ChannelState
setTopic = ASetter ChannelState ChannelState Text Text
-> Text -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ChannelState ChannelState Text Text
Lens' ChannelState Text
chanTopic