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

-- |
-- Module      : Network.Reddit.Types.Comment
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Comment
    ( Comment(..)
    , CommentID(CommentID)
    , MoreComments(..)
    , ChildComment(..)
    , WithChildren
    , WithReplies
    , commentP
    , LoadedChildren
    ) where

import           Control.Monad                   ( (<=<) )

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(..)
                 , Object
                 , Value(Object, String)
                 , withArray
                 , 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(toList, fromList) )
import           GHC.Generics                    ( Generic )

import           Lens.Micro

import           Network.Reddit.Types.Award
import           Network.Reddit.Types.Internal
import           Network.Reddit.Types.Submission ( SubmissionID )
import           Network.Reddit.Types.Subreddit

import           Web.HttpApiData                 ( ToHttpApiData(..) )

-- | A 'Comment' ID
newtype CommentID = CommentID Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, Ord, ToHttpApiData )

instance FromJSON CommentID where
    parseJSON = withText "CommentID" (coerce . dropTypePrefix CommentKind)

instance Thing CommentID where
    fullname (CommentID cid) = prependType CommentKind cid

-- | A Reddit comment
data Comment = Comment
    { commentID     :: CommentID
    , author        :: Username
    , body          :: Body
    , bodyHTML      :: Body
      -- | This field will be empty unless the comment was obtained
      -- via 'Network.Reddit.Comment.withReplies'
    , replies       :: Seq ChildComment
    , score         :: Maybe Integer
    , ups           :: Maybe Integer
    , downs         :: Maybe Integer
    , created       :: UTCTime
    , edited        :: Maybe UTCTime
    , subreddit     :: SubredditName
    , subredditID   :: SubredditID
    , gilded        :: Int
    , scoreHidden   :: Maybe Bool
    , linkID        :: SubmissionID
    , linkURL       :: Maybe URL
    , linkAuthor    :: Maybe Username
    , permaLink     :: URL
    , userReports   :: Seq ItemReport
    , modReports    :: Seq ItemReport
    , numReports    :: Maybe Integer
    , distinguished :: Maybe Distinction
      -- | Whether the author of the comment is also the submission author
    , isSubmitter   :: Bool
    , stickied      :: Bool
    , allAwardings  :: Seq Awarding
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Comment where
    parseJSON = withKind CommentKind "Comment" commentP

-- | Parse a 'Comment'
commentP :: Object -> Parser Comment
commentP o = do
    commentID <- o .: "id"
    author <- o .: "author"
    body <- o .: "body"
    bodyHTML <- o .: "body_html"
    replies <- repliesP =<< o .: "replies"
    score <- o .:? "score"
    ups <- o .:? "ups"
    downs <- o .:? "downs"
    created <- integerToUTC <$> o .: "created_utc"
    edited <- editedP =<< o .: "edited"
    subreddit <- o .: "subreddit"
    subredditID <- o .: "subreddit_id"
    gilded <- o .: "gilded"
    scoreHidden <- o .:? "score_hidden"
    linkID <- o .: "link_id"
    linkURL <- o .:? "link_url"
    linkAuthor <- o .:? "link_author"
    permaLink <- o .: "permalink"
    userReports <- o .: "user_reports"
    modReports <- o .: "mod_reports"
    numReports <- o .:? "num_reports"
    distinguished <- o .:? "distinguished"
    isSubmitter <- o .: "is_submitter"
    stickied <- o .: "stickied"
    allAwardings <- o .: "all_awardings"
    pure Comment { .. }
  where
    repliesP (String _)   = pure mempty
    repliesP v@(Object _) = parseJSON @(Listing CommentID ChildComment) v
        <&> (^. field @"children")
    repliesP _            = mempty

instance Paginable Comment where
    type PaginateOptions Comment = ItemOpts

    type PaginateThing Comment = CommentID

    defaultOpts = defaultItemOpts

    getFullname Comment { commentID } = commentID

-- | This wraps the 'ChildComment's of a 'Network.Reddit.Types.Submission.Submission'
newtype WithChildren = WithChildren (Seq ChildComment)
    deriving stock ( Show, Eq, Generic )

instance FromJSON WithChildren where
    parseJSON = withArray "WithChildren" (parseWithComments . toList)
      where
        parseWithComments [ _, cs ] = WithChildren
            <$> (parseJSON @(Listing CommentID ChildComment) cs
                 <&> (^. field @"children"))
        parseWithComments _         = mempty

-- | This wraps a 'Comment' which has been fetched with its 'ChildComment's
newtype WithReplies = WithReplies Comment
    deriving stock ( Show, Eq, Generic )

instance FromJSON WithReplies where
    parseJSON = withArray "WithReplies" (parseWithReplies . toList)
      where
        parseWithReplies [ _, cs ] = do
            Listing { children } <- parseJSON @(Listing CommentID Comment) cs
            case children of
                c :<| _ -> pure $ WithReplies c
                _       -> mempty

        parseWithReplies _         = mempty

-- | Represents a comments on a submission or replies to a comment, which can
-- be actual 'Comment's, or a list of children corresponding to \"load more\"
-- or \"continue this thread\" links on Reddit's UI
data ChildComment
    = TopLevel Comment
    | More MoreComments
    deriving stock ( Show, Eq, Generic )

instance FromJSON ChildComment where
    parseJSON = withObject "ChildComment" $ \o -> o .: "kind" >>= \case
        k
            | k == CommentKind -> TopLevel <$> parseJSON (Object o)
            | k == MoreKind -> More <$> parseJSON (Object o)
            | otherwise -> mempty

newtype LoadedChildren = LoadedChildren (Seq ChildComment)
    deriving stock ( Show, Generic )
    deriving newtype ( Eq )

instance FromJSON LoadedChildren where
    parseJSON = withObject "LoadedChildren"
        $ fmap (LoadedChildren . fromList)
        . (loadedP <=< (.: "things") <=< (.: "data") <=< (.: "json"))
      where
        loadedP = withArray "[ChildComment]" $ traverse parseJSON . toList

-- | A link to load more children 'Comment's
data MoreComments = MoreComments
    { childIDs :: Seq CommentID
      -- | The number of \"collapsed\" comments that can be loaded
    , count    :: Integer
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON MoreComments where
    parseJSON = withObject "MoreComments" $ parseMore <=< (.: "data")
      where
        parseMore o = MoreComments <$> o .: "children" <*> o .: "count"