{- This file is part of irc-fun-color.
 -
 - Written in 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/>.
 -}

-- | This module provides formatters for use with "Formatting". Suggested
-- usage:
--
-- > import Network.IRC.Fun.Color.Format
-- > import Network.IRC.Fun.Color.Format.Long
-- > import Formatting hiding (format, sformat, text, stext)
module Network.IRC.Fun.Color.Format.Long
    ( text
    , ltext
    , styled
    , nickname
    , channel
    , message
    )
where

import Data.Text.Lazy.Builder (fromText)
import Network.IRC.Fun.Color.Style (StyledText, encode)
import Network.IRC.Fun.Types

import qualified Data.Text as T (Text)
import qualified Data.Text.Lazy as TL (Text)
import qualified Formatting as F

-- | Output a strict 'T.Text'.
text :: F.Format r (T.Text -> r)
text = F.stext

-- | Output a lazy 'TL.Text'.
ltext :: F.Format r (TL.Text -> r)
ltext = F.text

-- | Render an IRC styled message.
styled :: F.Format r (StyledText -> r)
styled = F.later $ fromText . encode

-- | Output an IRC nickname as plain text.
nickname :: F.Format r (Nickname -> r)
nickname = F.later $ fromText . unNickname

-- | Output an IRC channel name as plain text.
channel :: F.Format r (Channel -> r)
channel = F.later $ fromText . unChannel

-- | Output IRC message content as plain text.
message :: F.Format r (MsgContent -> r)
message = F.later $ fromText . unMsgContent