Post.hs

module Reddit.Types.Post where

import Reddit.Parser
import Reddit.Types.Listing
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.Time.Clock
import Data.Time.Clock.POSIX
import Data.Monoid
import Data.Text (Text)
import Network.API.Builder.Query
import Prelude

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

instance FromJSON PostID where
  parseJSON (String s) =
    PostID <$> stripPrefix postPrefix s
  parseJSON _ = mempty

instance FromJSON (POSTWrapped PostID) where
  parseJSON (Object o) =
    POSTWrapped <$> ((o .: "json") >>= (.: "data") >>= (.: "id"))
  parseJSON _ = mempty

data Post = Post { postID :: PostID
                 , title :: Text
                 , permalink :: Text
                 , author :: Username
                 , score :: Integer
                 , created :: UTCTime
                 , content :: PostContent
                 , commentCount :: Integer
                 , liked :: Maybe Bool
                 , flairText :: Maybe Text
                 , flairClass :: Maybe Text
                 , domain :: Text
                 , gilded :: Integer
                 , nsfw :: Bool
                 , subreddit :: SubredditName
                 , subredditID :: SubredditID }
  deriving (Show, Read, Eq)

instance FromJSON Post where
  parseJSON (Object o) = do
    o `ensureKind` postPrefix
    d <- o .: "data"
    Post <$> d .: "id"
         <*> d .: "title"
         <*> d .: "permalink"
         <*> d .: "author"
         <*> d .: "score"
         <*> (posixSecondsToUTCTime . fromInteger <$> d .: "created_utc")
         <*> (buildContent <$> d .: "is_self" <*> d .:? "selftext" <*> d .:? "selftext_html" <*> d .: "url")
         <*> d .: "num_comments"
         <*> d .:? "likes"
         <*> d .:? "link_flair_text"
         <*> d .:? "link_flair_css_class"
         <*> d .: "domain"
         <*> d .: "gilded"
         <*> d .: "over_18"
         <*> d .: "subreddit"
         <*> d .: "subreddit_id"
  parseJSON _ = mempty

data PostContent = SelfPost Text Text
                 | Link Text
                 | TitleOnly
  deriving (Show, Read, Eq)

buildContent :: Bool -> Maybe Text -> Maybe Text -> Maybe Text -> PostContent
buildContent False _ _ (Just url) = Link url
buildContent True (Just s) (Just sHTML) _ = SelfPost (unescape s) sHTML
buildContent True (Just "") Nothing _ = TitleOnly
buildContent _ _ _ _ = undefined

instance Thing Post where
  fullName p = mconcat [postPrefix , "_", pID]
    where (PostID pID) = postID p

instance Thing PostID where
  fullName (PostID pID) = mconcat [postPrefix , "_", pID]

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

type PostListing = Listing PostID Post

postPrefix :: Text
postPrefix = "t3"