{- This file is part of irc-fun-types.
 -
 - Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

-- For deriving trivial no-op instances for newtypes
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Network.IRC.Fun.Types.Base
    ( Hostname (..)
    , ServiceName (..)
    , Username (..)
    , Nickname (..)
    , Channel (..)
    , CmdName (..)
    , CmdNumber (..)
    , Parameter
    , MsgContent (..)
    , Password (..)
    , ChannelKey (..)
    , ChannelTopic (..)
    , RealName (..)
    , Comment (..)
    , PortNumber (..)
    , Privilege (..)
    , ChannelPrivacy (..)
    )
where

import Data.Monoid (Monoid)
import Data.String (IsString)
import Data.Text (Text)

-- | IRC server hostname, e.g. @orwell.freenode.net@
newtype Hostname = Hostname { unHostname :: Text } deriving (Eq, Show)

-- | An IRC service name.
newtype ServiceName = ServiceName { unServiceName :: Text } deriving (Eq, Show)

-- | System user name, i.e. the first part of user\@host.tld
newtype Username = Username { unUsername :: Text } deriving (Eq, Show)

-- | IRC nickname
newtype Nickname = Nickname { unNickname :: Text } deriving (Eq, Show)

-- | IRC channel name (including the prefix character), e.g. @#freepost@
newtype Channel = Channel { unChannel :: Text } deriving (Eq, Show)

-- | IRC protocol command name, i.e. @PRIVMSG@
newtype CmdName = CmdName { unCmdName :: Text } deriving (Eq, Show)

-- | IRC protocol numeric command number
newtype CmdNumber = CmdNumber { unCmdNumber :: Int } deriving (Eq, Show)

-- | IRC message parameter, e.g. second word in @JOIN #freepost@
type Parameter = Text

-- | Chat message content, i.e. a message or a part of a text message meant to
-- be sent or received between people through IRC.
newtype MsgContent = MsgContent { unMsgContent :: Text }
    deriving (Show, Monoid, IsString)

-- | IRC connection password.
newtype Password = Password { unPassword :: Text } deriving (Eq, Show)

-- | IRC channel password.
newtype ChannelKey = ChannelKey { unChannelKey :: Text } deriving (Eq, Show)

-- | IRC channel topic line.
newtype ChannelTopic = ChannelTopic { unChannelTopic :: Text } deriving Show

-- | A user's \"real name\" as kept by the IRC server.
newtype RealName = RealName { unRealName :: Text } deriving Show

-- | An optional comment used by several IRC commands, e.g. a part message,
-- which is a line shown when a user leaves a channel.
newtype Comment = Comment { unComment :: Text } deriving Show

-- | Network port number.
newtype PortNumber = PortNumber { unPortNumber :: Int } deriving (Eq, Show)

-- | IRC privilege status for a user in the context of a specific channel.
data Privilege = Regular | Voice | Operator deriving (Eq, Show)

-- | IRC channel privacy settings.
data ChannelPrivacy = Secret | Private | Public deriving (Eq, Show)