{-# 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(..)
  , chanTopic
  , chanTopicProvenance
  , chanUrl
  , chanUsers
  , chanModes
  , chanLists
  , chanCreation
  , chanQueuedModeration

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

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

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

-- | Dynamic information about the state of an IRC channel
data ChannelState = ChannelState
  { 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
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
(Int -> TopicProvenance -> ShowS)
-> (TopicProvenance -> String)
-> ([TopicProvenance] -> ShowS)
-> Show TopicProvenance
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
(Int -> MaskListEntry -> ShowS)
-> (MaskListEntry -> String)
-> ([MaskListEntry] -> ShowS)
-> Show MaskListEntry
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

-- | Construct an empty 'ChannelState'
newChannel :: ChannelState
newChannel :: ChannelState
newChannel = ChannelState :: Text
-> Maybe TopicProvenance
-> Maybe Text
-> HashMap Identifier String
-> Map Char Text
-> Map Char (HashMap Text MaskListEntry)
-> Maybe UTCTime
-> [RawIrcMsg]
-> ChannelState
ChannelState
  { _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
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