{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Network.Reddit.Types.Message
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Message
    ( Message(..)
    , PrivateMessageID(PrivateMessageID)
    , MessageID(..)
    , MessageOpts(..)
    , NewMessage(..)
    , PostedMessage
    ) where

import           Data.Aeson
                 ( (.:)
                 , FromJSON(..)
                 , Object
                 , Options(sumEncoding)
                 , SumEncoding(UntaggedValue)
                 , Value(..)
                 , defaultOptions
                 , genericParseJSON
                 , withObject
                 , withText
                 )
import           Data.Aeson.Types              ( Parser )
import           Data.Coerce                   ( coerce )
import           Data.Generics.Product         ( HasField(field) )
import           Data.Sequence                 ( Seq )
import           Data.Text                     ( Text )
import           Data.Time                     ( UTCTime )

import           GHC.Exts                      ( IsList(fromList) )
import           GHC.Generics                  ( Generic )

import           Lens.Micro

import           Network.Reddit.Types.Account
import           Network.Reddit.Types.Comment  ( CommentID )
import           Network.Reddit.Types.Internal

import           Web.FormUrlEncoded            ( ToForm(..) )
import           Web.HttpApiData               ( ToHttpApiData(toQueryParam) )

-- | A private message or comment reply
data Message = Message
    { messageID :: MessageID
    , author    :: Username
    , dest      :: Username
    , body      :: Body
    , bodyHTML  :: Body
    , subject   :: Subject
    , created   :: UTCTime
    , new       :: Bool
    , replies   :: Seq Message
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Message where
    parseJSON = withKinds [ MessageKind, CommentKind ] "Message" messageP

messageP :: Object -> Parser Message
messageP o = Message <$> (o .: "name")
    <*> (o .: "author")
    <*> (o .: "dest")
    <*> (o .: "body")
    <*> (o .: "body_html")
    <*> (o .: "subject")
    <*> (integerToUTC <$> o .: "created")
    <*> (o .: "new")
    <*> (repliesP =<< o .: "replies")
  where
    repliesP (String _)   = pure mempty
    repliesP v@(Object _) = parseJSON @(Listing MessageID Message) v
        <&> (^. field @"children")
    repliesP _            = mempty

instance Paginable Message where
    type PaginateOptions Message = MessageOpts

    type PaginateThing Message = MessageID

    defaultOpts = MessageOpts { mark = False }

    getFullname Message { messageID } = messageID

-- | Options for requesting and paginating 'Listing's of 'Message's
data MessageOpts = MessageOpts
    { -- | If set to @False@ (the default), any new messages read via the API
      -- will maintain their unread status in the web UI
      mark :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm MessageOpts where
    toForm MessageOpts { .. } = fromList [ ("mark", toQueryParam mark) ]

-- | This can be 'CommentID' for replies to a comment, or a 'PrivateMessageID'
-- for private messages. Querying one's inbox or unread messages can provide
-- both types
data MessageID
    = CommentReply CommentID
    | PrivateMessage PrivateMessageID
    deriving stock ( Show, Eq, Generic, Ord )

instance FromJSON MessageID where
    parseJSON =
        genericParseJSON defaultOptions { sumEncoding = UntaggedValue }

instance ToHttpApiData MessageID where
    toQueryParam (CommentReply cid)   = toQueryParam cid
    toQueryParam (PrivateMessage mid) = toQueryParam mid

instance Thing MessageID where
    fullname (CommentReply cid)   = fullname cid
    fullname (PrivateMessage mid) = fullname mid

-- | A private message ID
newtype PrivateMessageID = PrivateMessageID Text
    deriving stock ( Show, Generic, Ord )
    deriving newtype ( Eq, ToHttpApiData )

instance FromJSON PrivateMessageID where
    parseJSON =
        withText "PrivateMessageID" (coerce . dropTypePrefix MessageKind)

instance Thing PrivateMessageID where
    fullname = prependType MessageKind . coerce

-- | For sending new 'Message's via the @compose@ API endpoint
data NewMessage = NewMessage
    { -- | The subject should be <= 100 characters in length
      subject :: Subject
    , message :: Body
    , dest    :: Username
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm NewMessage where
    toForm NewMessage { .. } =
        fromList [ ("to", toQueryParam dest)
                 , ("subject", subject)
                 , ("text", message)
                 ]

newtype PostedMessage = PostedMessage Message
    deriving stock ( Show, Generic )
    deriving newtype ( Eq )

instance FromJSON PostedMessage where
    parseJSON = withObject "PostedMessage" $ \o -> postedMessageP
        =<< ((.: "things") =<< (.: "data") =<< o .: "json")
      where
        postedMessageP [ Object o ] = PostedMessage
            <$> (messageP =<< o .: "data")
        postedMessageP _            = mempty