{- This file is part of irc-fun-messages.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ 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/>.
 -}

module Network.IRC.Fun.Messages.Internal.Serialize
    ( -- * Building
      buildMessage
    , buildReply
    , messageFromReply
      -- * Serializing
    , serializeMessage
    , serializeReply
    )
where

import Data.Bits (bit, zeroBits, (.|.))
--import Data.Char (toUpper)
import Data.List (intercalate)
import Data.Maybe (maybeToList)
import Network.IRC.Fun.Messages.Mask (serializeMask)
--import Network.IRC.Fun.Messages.Modes (parseUserMode)
--import Network.IRC.Fun.Messages.Reply (messageToReply, messageIsReply)
import Network.IRC.Fun.Messages.Internal.Types

-------------------------------------------------------------------------------
-- Building
-------------------------------------------------------------------------------

showAddr :: Address -> String
showAddr (IPv4 s) = s
showAddr (IPv6 s) = s

showHost :: Host -> String
showHost (HostName hn)   = hn
showHost (HostAddr addr) = showAddr addr
showHost (HostCloak s)   = s

showTargetMask :: TargetMask -> String
showTargetMask (HostMask m)   = '#' : serializeMask m
showTargetMask (ServerMask m) = '$' : serializeMask m

showTarget :: MessageTarget -> String
showTarget (ChannelTarget chan) = chan
showTarget (UserTarget Nothing (Just (UserAddr user mhost)) (Just server)) =
    maybe user ((user ++) . ('%' :) . showHost) mhost ++ '@' : server
showTarget (UserTarget Nothing (Just (UserAddr user (Just host))) Nothing) =
    user ++ '%' : showHost host
showTarget (UserTarget (Just nick) Nothing Nothing) = nick
showTarget (UserTarget (Just nick) (Just (UserAddr user (Just host))) Nothing)
    = nick ++ '!' : user ++ '@' : showHost host
showTarget (MaskTarget mt) = showTargetMask mt
showTarget _ = "invalid_target"

-- Fill command name and parameters from specific message
buildMessage' :: Message -> (CommandName, [Parameter])
buildMessage' msg =
    case msg of
        PassMessage pass -> ("PASS", [pass])
        NickMessage nn -> ("NICK", [nn])
        UserMessage un i w rn ->
            ("USER", [un, show $ modebit 3 i .|. modebit 2 w, "*", rn])
            where
            modebit n b = if b then bit n else zeroBits :: Int
        OperMessage un p -> ("????", error "Not implemented")
        UserModeMessage n remove add -> ("????", error "Not implemented")
        ServiceMessage n m s -> ("????", error "Not implemented")
        QuitMessage reason -> ("QUIT", perhaps reason)
        SQuitMessage s t -> ("????", error "Not implemented")
        JoinMessage Nothing -> ("JOIN", ["0"])
        JoinMessage (Just (chans, keys)) ->
            ("JOIN", intercalate "," chans :
                     if null keys then [] else [intercalate "," keys])
        PartMessage chans reason -> ("PART", intercalate "," chans ?: reason)
        ChannelModeMessage remove add -> ("????", error "Not implemented")
        TopicMessage chan topic -> ("TOPIC", chan ?: topic)
        NamesMessage chans serv -> ("NAMES", intercalate "," chans ?: serv)
        ListMessage chans serv -> ("????", error "Not implemented")
        InviteMessage nn chan -> ("????", error "Not implemented")
        KickMessage chans users s -> ("????", error "Not implemented")
        PrivMsgMessage tgt text -> ("PRIVMSG", [showTarget tgt, text])
        PrivActionMessage tgt text ->
            ("PRIVMSG", [showTarget tgt, "\1ACTION " ++ text ++ "\1"])
        NoticeMessage tgt text -> ("NOTICE", [showTarget tgt, text])
        MotdMessage serv -> ("????", error "Not implemented")
        LusersMessage serv -> ("????", error "Not implemented")
        VersionMessage serv -> ("????", error "Not implemented")
        StatsMessage x -> ("????", error "Not implemented")
        LinksMessage x -> ("????", error "Not implemented")
        TimeMessage serv -> ("????", error "Not implemented")
        ConnectMessage serv portn sm -> ("????", error "Not implemented")
        TraceMessage t -> ("????", error "Not implemented")
        AdminMessage t -> ("????", error "Not implemented")
        InfoMessage t -> ("????", error "Not implemented")
        ServlistMessage _ -> ("????", error "Not implemented")
        SQueryMessage _ _ -> ("????", error "Not implemented")
        WhoMessage _ -> ("????", error "Not implemented")
        WhoisMessage _ _ -> ("????", error "Not implemented")
        WhowasMessage _ _ -> ("????", error "Not implemented")
        KillMessage _ _ -> ("????", error "Not implemented")
        PingMessage s1 s2 -> ("PING", s1 ?: s2)
        PongMessage s1 s2 -> ("PONG", s1 ?: s2)
        ErrorMessage _ -> ("????", error "Not implemented")
        AwayMessage _ -> ("????", error "Not implemented")
        RehashMessage -> ("????", error "Not implemented")
        DieMessage -> ("????", error "Not implemented")
        RestartMessage -> ("????", error "Not implemented")
        SummonMessage _ _ -> ("????", error "Not implemented")
        UsersMessage _ -> ("????", error "Not implemented")
        WallopsMessage _ -> ("????", error "Not implemented")
        UserhostMessage _ -> ("????", error "Not implemented")
        IsonMessage _ -> ("????", error "Not implemented")
    where
    perhaps = maybeToList
    x ?: my = x : perhaps my

-- | Fill a generic message record using a specific message's details.
buildMessage :: SpecificMessage -> GenericMessage
buildMessage (SpecificMessage pref msg) =
    let (cmd, ps) = buildMessage' msg
    in  GenericMessage pref (StringCommand cmd) ps

channelPrivacyChar :: ChannelPrivacy -> Char
channelPrivacyChar Secret  = '@'
channelPrivacyChar Private = '*'
channelPrivacyChar Public  = '='

privilegeChar :: Privilege -> Maybe Char
privilegeChar Regular  = Nothing
privilegeChar Voice    = Just '+'
privilegeChar Operator = Just '@'

-- Fill reply code, target and parameters from specific reply
buildReply' :: Reply -> (Int, [Parameter])
buildReply' reply =
    case reply of
        NamesReply priv chan pns ->
            ( 353
            , [ [channelPrivacyChar priv]
              , chan
              , unwords $
                map (\ (p, n) -> maybe n (: n) $ privilegeChar p) pns
              ]
            )
        _ -> error "Not implemented"

-- | Fill a generic reply record using a specific reply's details.
buildReply :: SpecificReply -> GenericReply
buildReply (SpecificReply sender tgt reply) =
    let (code, ps) = buildReply' reply
    in  GenericReply sender code tgt ps

-- | Convert a reply, which is a message with a numeric command name, into a
-- generic message value.
messageFromReply :: GenericReply -> GenericMessage
messageFromReply reply = GenericMessage
    { gmPrefix  = Just $ Server $ grSender reply
    , gmCommand = NumericCommand $ grCode reply
    , gmParams  = target' reply : grParams reply
    }
    where
    target' (GenericReply { grTarget = NickTarget n })   = n
    target' (GenericReply { grTarget = ServerTarget s }) = s

-------------------------------------------------------------------------------
-- Serializing
-------------------------------------------------------------------------------

serializePrefix :: Prefix -> String
serializePrefix (Server sn)    = sn
serializePrefix (Nick n mu mh) =  n
                               ++ maybe "" ('!' :) mu
                               ++ maybe "" (('@' :) . showHost) mh

serializeCommand :: Command -> String
serializeCommand (StringCommand s)  = s
serializeCommand (NumericCommand n) = show n

serializeParams :: [Parameter] -> String
serializeParams = f . map (\ p -> if null p then "(?)" else p)
    where
    f [] = ""
    f l  =
        let (ps, p) = (init l, last l)
        in  concatMap (' ' :) ps ++ ' ' :
            if head p == ':' || ' ' `elem` p
                then ':' : p
                else p

-- | Write a message into an IRC protocol message formatted string.
serializeMessage :: GenericMessage -> String
serializeMessage msg = concat
    [ maybe "" (\ p -> ':' : serializePrefix p ++ " ") $ gmPrefix msg
    , serializeCommand $ gmCommand msg
    , serializeParams $ gmParams msg
    , "\r\n"
    ]

-- | Write a reply into an IRC protocol message formatted string.
--
-- This is essentially a combination of 'messageFromReply' and
-- 'serializeMessage'.
serializeReply :: GenericReply -> String
serializeReply = serializeMessage . messageFromReply