module Reddit.Types.Comment where

import Reddit.Parser
import Reddit.Types.Listing
import Reddit.Types.Post hiding (author)
import Reddit.Types.Reddit
import Reddit.Types.Subreddit
import Reddit.Types.Thing
import Reddit.Types.User
import Reddit.Utilities

import Control.Applicative
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Monoid
import Data.Text (Text)
import Data.Traversable
import Network.API.Builder.Query
import Prelude
import qualified Data.Text as Text
import qualified Data.Vector as Vector

newtype CommentID = CommentID Text
  deriving (Show, Read, Eq, Ord)

instance FromJSON CommentID where
  parseJSON (String s) =
    CommentID <$> stripPrefix commentPrefix s
  parseJSON _ = mempty

instance Thing CommentID where
  fullName (CommentID cID) = Text.concat [commentPrefix, "_", cID]

instance ToQuery CommentID where
  toQuery k v = [(k, fullName v)]

instance FromJSON (POSTWrapped CommentID) where
  parseJSON (Object o) = do
    ts <- (o .: "json") >>= (.: "data") >>= (.: "things")
    case Vector.toList ts of
      [v] -> POSTWrapped <$> (v .: "data" >>= (.: "id"))
      _ -> mempty
  parseJSON _ = mempty

data CommentReference = Reference Integer [CommentID]
                      | Actual Comment
  deriving (Show, Read, Eq)

instance FromJSON CommentReference where
  parseJSON v@(Object o) = do
    k <- o .: "kind"
    case k of
      String "t1" -> Actual <$> parseJSON v
      String "more" ->
        Reference <$> ((o .: "data") >>= (.: "count"))
                  <*> ((o .: "data") >>= (.: "children"))
      _ -> mempty
  parseJSON _ = mempty

instance FromJSON (POSTWrapped [CommentReference]) where
  parseJSON (Object o) = do
    cs <- (o .: "json") >>= (.: "data") >>= (.: "things")
    POSTWrapped <$> parseJSON cs
  parseJSON _ = mempty

-- | @isReference c@ returns is true if @c@ is an actual comment, false otherwise
isActual :: CommentReference -> Bool
isActual (Actual _) = True
isActual _ = False

-- | @isReference c@ returns is true if @c@ is a reference, false otherwise
isReference :: CommentReference -> Bool
isReference (Reference _ _) = True
isReference _ = False

data Comment = Comment { commentID :: CommentID
                       , score :: Maybe Integer
                       , subredditID :: SubredditID
                       , subreddit :: SubredditName
                       , gilded :: Integer
                       , saved :: Bool
                       , author :: Username
                       , authorFlairCSSClass :: Maybe Text
                       , authorFlairText :: Maybe Text
                       , body :: Text
                       , bodyHTML :: Text
                       , replies :: Listing CommentID CommentReference
                       , created :: UTCTime
                       , edited :: Maybe UTCTime
                       , parentLink :: PostID
                       , inReplyTo :: Maybe CommentID }
  deriving (Show, Read, Eq)

instance Thing Comment where
  fullName c = fullName (commentID c)

instance FromJSON Comment where
  parseJSON (Object o) = do
    o `ensureKind` commentPrefix
    d <- o .: "data"
    Comment <$> d .: "id"
            <*> d .:? "score"
            <*> d .: "subreddit_id"
            <*> d .: "subreddit"
            <*> d .: "gilded"
            <*> d .: "saved"
            <*> d .: "author"
            <*> d .:? "author_flair_css_class"
            <*> d .:? "author_flair_text"
            <*> (unescape <$> d .: "body")
            <*> d .: "body_html"
            <*> d .: "replies"
            <*> (posixSecondsToUTCTime . fromInteger <$> d .: "created_utc")
            <*> ((fmap (posixSecondsToUTCTime . fromInteger) <$> d .: "edited") <|> pure Nothing)
            <*> (parseJSON =<< d .: "link_id")
            <*> (d .:? "parent_id" >>= \v -> traverse parseJSON v <|> pure Nothing)
  parseJSON _ = mempty

instance FromJSON (POSTWrapped Comment) where
  parseJSON (Object o) = do
    ts <- (o .: "json") >>= (.: "data") >>= (.: "things")
    case Vector.toList ts of
      [c] -> POSTWrapped <$> parseJSON c
      _ -> mempty
  parseJSON _ = mempty

treeSubComments :: CommentReference -> [CommentReference]
treeSubComments a@(Actual c) = a : concatMap treeSubComments ((\(Listing _ _ cs) -> cs) $ replies c)
treeSubComments (Reference _ rs) = map (\r -> Reference 1 [r]) rs

isDeleted :: Comment -> Bool
isDeleted = (== Username "[deleted]") . author

data PostComments = PostComments Post [CommentReference]
  deriving (Show, Read, Eq)

instance FromJSON PostComments where
  parseJSON (Array a) =
    case Vector.toList a of
      postListing:commentListing:_ -> do
        Listing _ _ [post] <- parseJSON postListing :: Parser (Listing PostID Post)
        Listing _ _ comments <- parseJSON commentListing :: Parser (Listing CommentID CommentReference)
        return $ PostComments post comments
      _ -> mempty
  parseJSON _ = mempty

type CommentListing = Listing CommentID Comment

commentPrefix :: Text
commentPrefix = "t1"