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 (Int -> PostID -> ShowS
[PostID] -> ShowS
PostID -> String
(Int -> PostID -> ShowS)
-> (PostID -> String) -> ([PostID] -> ShowS) -> Show PostID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostID] -> ShowS
$cshowList :: [PostID] -> ShowS
show :: PostID -> String
$cshow :: PostID -> String
showsPrec :: Int -> PostID -> ShowS
$cshowsPrec :: Int -> PostID -> ShowS
Show, ReadPrec [PostID]
ReadPrec PostID
Int -> ReadS PostID
ReadS [PostID]
(Int -> ReadS PostID)
-> ReadS [PostID]
-> ReadPrec PostID
-> ReadPrec [PostID]
-> Read PostID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostID]
$creadListPrec :: ReadPrec [PostID]
readPrec :: ReadPrec PostID
$creadPrec :: ReadPrec PostID
readList :: ReadS [PostID]
$creadList :: ReadS [PostID]
readsPrec :: Int -> ReadS PostID
$creadsPrec :: Int -> ReadS PostID
Read, PostID -> PostID -> Bool
(PostID -> PostID -> Bool)
-> (PostID -> PostID -> Bool) -> Eq PostID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostID -> PostID -> Bool
$c/= :: PostID -> PostID -> Bool
== :: PostID -> PostID -> Bool
$c== :: PostID -> PostID -> Bool
Eq, Eq PostID
Eq PostID
-> (PostID -> PostID -> Ordering)
-> (PostID -> PostID -> Bool)
-> (PostID -> PostID -> Bool)
-> (PostID -> PostID -> Bool)
-> (PostID -> PostID -> Bool)
-> (PostID -> PostID -> PostID)
-> (PostID -> PostID -> PostID)
-> Ord PostID
PostID -> PostID -> Bool
PostID -> PostID -> Ordering
PostID -> PostID -> PostID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PostID -> PostID -> PostID
$cmin :: PostID -> PostID -> PostID
max :: PostID -> PostID -> PostID
$cmax :: PostID -> PostID -> PostID
>= :: PostID -> PostID -> Bool
$c>= :: PostID -> PostID -> Bool
> :: PostID -> PostID -> Bool
$c> :: PostID -> PostID -> Bool
<= :: PostID -> PostID -> Bool
$c<= :: PostID -> PostID -> Bool
< :: PostID -> PostID -> Bool
$c< :: PostID -> PostID -> Bool
compare :: PostID -> PostID -> Ordering
$ccompare :: PostID -> PostID -> Ordering
$cp1Ord :: Eq PostID
Ord)

instance FromJSON PostID where
  parseJSON :: Value -> Parser PostID
parseJSON (String Text
s) =
    Text -> PostID
PostID (Text -> PostID) -> Parser Text -> Parser PostID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Parser Text
stripPrefix Text
postPrefix Text
s
  parseJSON Value
_ = Parser PostID
forall a. Monoid a => a
mempty

instance FromJSON (POSTWrapped PostID) where
  parseJSON :: Value -> Parser (POSTWrapped PostID)
parseJSON (Object Object
o) =
    PostID -> POSTWrapped PostID
forall a. a -> POSTWrapped a
POSTWrapped (PostID -> POSTWrapped PostID)
-> Parser PostID -> Parser (POSTWrapped PostID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"json") Parser Object -> (Object -> Parser Object) -> Parser Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data") Parser Object -> (Object -> Parser PostID) -> Parser PostID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser PostID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"))
  parseJSON Value
_ = Parser (POSTWrapped PostID)
forall a. Monoid a => a
mempty

data Post = Post { Post -> PostID
postID :: PostID
                 , Post -> Text
title :: Text
                 , Post -> Text
permalink :: Text
                 , Post -> Username
author :: Username
                 , Post -> Integer
score :: Integer
                 , Post -> UTCTime
created :: UTCTime
                 , Post -> PostContent
content :: PostContent
                 , Post -> Integer
commentCount :: Integer
                 , Post -> Maybe Bool
liked :: Maybe Bool
                 , Post -> Maybe Text
flairText :: Maybe Text
                 , Post -> Maybe Text
flairClass :: Maybe Text
                 , Post -> Text
domain :: Text
                 , Post -> Integer
gilded :: Integer
                 , Post -> Bool
nsfw :: Bool
                 , Post -> SubredditName
subreddit :: SubredditName
                 , Post -> SubredditID
subredditID :: SubredditID }
  deriving (Int -> Post -> ShowS
[Post] -> ShowS
Post -> String
(Int -> Post -> ShowS)
-> (Post -> String) -> ([Post] -> ShowS) -> Show Post
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Post] -> ShowS
$cshowList :: [Post] -> ShowS
show :: Post -> String
$cshow :: Post -> String
showsPrec :: Int -> Post -> ShowS
$cshowsPrec :: Int -> Post -> ShowS
Show, ReadPrec [Post]
ReadPrec Post
Int -> ReadS Post
ReadS [Post]
(Int -> ReadS Post)
-> ReadS [Post] -> ReadPrec Post -> ReadPrec [Post] -> Read Post
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Post]
$creadListPrec :: ReadPrec [Post]
readPrec :: ReadPrec Post
$creadPrec :: ReadPrec Post
readList :: ReadS [Post]
$creadList :: ReadS [Post]
readsPrec :: Int -> ReadS Post
$creadsPrec :: Int -> ReadS Post
Read, Post -> Post -> Bool
(Post -> Post -> Bool) -> (Post -> Post -> Bool) -> Eq Post
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Post -> Post -> Bool
$c/= :: Post -> Post -> Bool
== :: Post -> Post -> Bool
$c== :: Post -> Post -> Bool
Eq)

instance FromJSON Post where
  parseJSON :: Value -> Parser Post
parseJSON (Object Object
o) = do
    Object
o Object -> Text -> Parser ()
`ensureKind` Text
postPrefix
    Object
d <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    PostID
-> Text
-> Text
-> Username
-> Integer
-> UTCTime
-> PostContent
-> Integer
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Text
-> Integer
-> Bool
-> SubredditName
-> SubredditID
-> Post
Post (PostID
 -> Text
 -> Text
 -> Username
 -> Integer
 -> UTCTime
 -> PostContent
 -> Integer
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Integer
 -> Bool
 -> SubredditName
 -> SubredditID
 -> Post)
-> Parser PostID
-> Parser
     (Text
      -> Text
      -> Username
      -> Integer
      -> UTCTime
      -> PostContent
      -> Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
d Object -> Key -> Parser PostID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
         Parser
  (Text
   -> Text
   -> Username
   -> Integer
   -> UTCTime
   -> PostContent
   -> Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser Text
-> Parser
     (Text
      -> Username
      -> Integer
      -> UTCTime
      -> PostContent
      -> Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
         Parser
  (Text
   -> Username
   -> Integer
   -> UTCTime
   -> PostContent
   -> Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser Text
-> Parser
     (Username
      -> Integer
      -> UTCTime
      -> PostContent
      -> Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permalink"
         Parser
  (Username
   -> Integer
   -> UTCTime
   -> PostContent
   -> Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser Username
-> Parser
     (Integer
      -> UTCTime
      -> PostContent
      -> Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser Username
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"author"
         Parser
  (Integer
   -> UTCTime
   -> PostContent
   -> Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser Integer
-> Parser
     (UTCTime
      -> PostContent
      -> Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"score"
         Parser
  (UTCTime
   -> PostContent
   -> Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser UTCTime
-> Parser
     (PostContent
      -> Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Integer -> POSIXTime) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
d Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_utc")
         Parser
  (PostContent
   -> Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser PostContent
-> Parser
     (Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Text -> Maybe Text -> Maybe Text -> PostContent
buildContent (Bool -> Maybe Text -> Maybe Text -> Maybe Text -> PostContent)
-> Parser Bool
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> PostContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
d Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"is_self" Parser (Maybe Text -> Maybe Text -> Maybe Text -> PostContent)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> PostContent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"selftext" Parser (Maybe Text -> Maybe Text -> PostContent)
-> Parser (Maybe Text) -> Parser (Maybe Text -> PostContent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"selftext_html" Parser (Maybe Text -> PostContent)
-> Parser (Maybe Text) -> Parser PostContent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url")
         Parser
  (Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser Integer
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"num_comments"
         Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Integer
      -> Bool
      -> SubredditName
      -> SubredditID
      -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"likes"
         Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Integer
   -> Bool
   -> SubredditName
   -> SubredditID
   -> Post)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text -> Integer -> Bool -> SubredditName -> SubredditID -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"link_flair_text"
         Parser
  (Maybe Text
   -> Text -> Integer -> Bool -> SubredditName -> SubredditID -> Post)
-> Parser (Maybe Text)
-> Parser
     (Text -> Integer -> Bool -> SubredditName -> SubredditID -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"link_flair_css_class"
         Parser
  (Text -> Integer -> Bool -> SubredditName -> SubredditID -> Post)
-> Parser Text
-> Parser (Integer -> Bool -> SubredditName -> SubredditID -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"domain"
         Parser (Integer -> Bool -> SubredditName -> SubredditID -> Post)
-> Parser Integer
-> Parser (Bool -> SubredditName -> SubredditID -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gilded"
         Parser (Bool -> SubredditName -> SubredditID -> Post)
-> Parser Bool -> Parser (SubredditName -> SubredditID -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"over_18"
         Parser (SubredditName -> SubredditID -> Post)
-> Parser SubredditName -> Parser (SubredditID -> Post)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser SubredditName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subreddit"
         Parser (SubredditID -> Post) -> Parser SubredditID -> Parser Post
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser SubredditID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subreddit_id"
  parseJSON Value
_ = Parser Post
forall a. Monoid a => a
mempty

data PostContent = SelfPost Text Text
                 | Link Text
                 | TitleOnly
  deriving (Int -> PostContent -> ShowS
[PostContent] -> ShowS
PostContent -> String
(Int -> PostContent -> ShowS)
-> (PostContent -> String)
-> ([PostContent] -> ShowS)
-> Show PostContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostContent] -> ShowS
$cshowList :: [PostContent] -> ShowS
show :: PostContent -> String
$cshow :: PostContent -> String
showsPrec :: Int -> PostContent -> ShowS
$cshowsPrec :: Int -> PostContent -> ShowS
Show, ReadPrec [PostContent]
ReadPrec PostContent
Int -> ReadS PostContent
ReadS [PostContent]
(Int -> ReadS PostContent)
-> ReadS [PostContent]
-> ReadPrec PostContent
-> ReadPrec [PostContent]
-> Read PostContent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostContent]
$creadListPrec :: ReadPrec [PostContent]
readPrec :: ReadPrec PostContent
$creadPrec :: ReadPrec PostContent
readList :: ReadS [PostContent]
$creadList :: ReadS [PostContent]
readsPrec :: Int -> ReadS PostContent
$creadsPrec :: Int -> ReadS PostContent
Read, PostContent -> PostContent -> Bool
(PostContent -> PostContent -> Bool)
-> (PostContent -> PostContent -> Bool) -> Eq PostContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostContent -> PostContent -> Bool
$c/= :: PostContent -> PostContent -> Bool
== :: PostContent -> PostContent -> Bool
$c== :: PostContent -> PostContent -> Bool
Eq)

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

instance Thing Post where
  fullName :: Post -> Text
fullName Post
p = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
postPrefix , Text
"_", Text
pID]
    where (PostID Text
pID) = Post -> PostID
postID Post
p

instance Thing PostID where
  fullName :: PostID -> Text
fullName (PostID Text
pID) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
postPrefix , Text
"_", Text
pID]

instance ToQuery PostID where
  toQuery :: Text -> PostID -> [(Text, Text)]
toQuery Text
k PostID
v = [(Text
k, PostID -> Text
forall a. Thing a => a -> Text
fullName PostID
v)]

type PostListing = Listing PostID Post

postPrefix :: Text
postPrefix :: Text
postPrefix = Text
"t3"