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

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

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

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

instance FromJSON (POSTWrapped CommentID) where
  parseJSON :: Value -> Parser (POSTWrapped CommentID)
parseJSON (Object Object
o) = do
    Vector Object
ts <- (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 (Vector Object)) -> Parser (Vector Object)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser (Vector Object)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"things")
    case Vector Object -> [Object]
forall a. Vector a -> [a]
Vector.toList Vector Object
ts of
      [Object
v] -> CommentID -> POSTWrapped CommentID
forall a. a -> POSTWrapped a
POSTWrapped (CommentID -> POSTWrapped CommentID)
-> Parser CommentID -> Parser (POSTWrapped CommentID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data" Parser Object -> (Object -> Parser CommentID) -> Parser CommentID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser CommentID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"))
      [Object]
_ -> Parser (POSTWrapped CommentID)
forall a. Monoid a => a
mempty
  parseJSON Value
_ = Parser (POSTWrapped CommentID)
forall a. Monoid a => a
mempty

data CommentReference = Reference Integer [CommentID]
                      | Actual Comment
  deriving (Int -> CommentReference -> ShowS
[CommentReference] -> ShowS
CommentReference -> String
(Int -> CommentReference -> ShowS)
-> (CommentReference -> String)
-> ([CommentReference] -> ShowS)
-> Show CommentReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentReference] -> ShowS
$cshowList :: [CommentReference] -> ShowS
show :: CommentReference -> String
$cshow :: CommentReference -> String
showsPrec :: Int -> CommentReference -> ShowS
$cshowsPrec :: Int -> CommentReference -> ShowS
Show, ReadPrec [CommentReference]
ReadPrec CommentReference
Int -> ReadS CommentReference
ReadS [CommentReference]
(Int -> ReadS CommentReference)
-> ReadS [CommentReference]
-> ReadPrec CommentReference
-> ReadPrec [CommentReference]
-> Read CommentReference
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommentReference]
$creadListPrec :: ReadPrec [CommentReference]
readPrec :: ReadPrec CommentReference
$creadPrec :: ReadPrec CommentReference
readList :: ReadS [CommentReference]
$creadList :: ReadS [CommentReference]
readsPrec :: Int -> ReadS CommentReference
$creadsPrec :: Int -> ReadS CommentReference
Read, CommentReference -> CommentReference -> Bool
(CommentReference -> CommentReference -> Bool)
-> (CommentReference -> CommentReference -> Bool)
-> Eq CommentReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentReference -> CommentReference -> Bool
$c/= :: CommentReference -> CommentReference -> Bool
== :: CommentReference -> CommentReference -> Bool
$c== :: CommentReference -> CommentReference -> Bool
Eq)

instance FromJSON CommentReference where
  parseJSON :: Value -> Parser CommentReference
parseJSON v :: Value
v@(Object Object
o) = do
    Value
k <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    case Value
k of
      String Text
"t1" -> Comment -> CommentReference
Actual (Comment -> CommentReference)
-> Parser Comment -> Parser CommentReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Comment
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      String Text
"more" ->
        Integer -> [CommentID] -> CommentReference
Reference (Integer -> [CommentID] -> CommentReference)
-> Parser Integer -> Parser ([CommentID] -> CommentReference)
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
"data") Parser Object -> (Object -> Parser Integer) -> Parser Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"count"))
                  Parser ([CommentID] -> CommentReference)
-> Parser [CommentID] -> Parser CommentReference
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data") Parser Object
-> (Object -> Parser [CommentID]) -> Parser [CommentID]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser [CommentID]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"children"))
      Value
_ -> Parser CommentReference
forall a. Monoid a => a
mempty
  parseJSON Value
_ = Parser CommentReference
forall a. Monoid a => a
mempty

instance FromJSON (POSTWrapped [CommentReference]) where
  parseJSON :: Value -> Parser (POSTWrapped [CommentReference])
parseJSON (Object Object
o) = do
    Value
cs <- (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 Value) -> Parser Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"things")
    [CommentReference] -> POSTWrapped [CommentReference]
forall a. a -> POSTWrapped a
POSTWrapped ([CommentReference] -> POSTWrapped [CommentReference])
-> Parser [CommentReference]
-> Parser (POSTWrapped [CommentReference])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [CommentReference]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
cs
  parseJSON Value
_ = Parser (POSTWrapped [CommentReference])
forall a. Monoid a => a
mempty

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

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

data Comment = Comment { Comment -> CommentID
commentID :: CommentID
                       , Comment -> Maybe Integer
score :: Maybe Integer
                       , Comment -> SubredditID
subredditID :: SubredditID
                       , Comment -> SubredditName
subreddit :: SubredditName
                       , Comment -> Integer
gilded :: Integer
                       , Comment -> Bool
saved :: Bool
                       , Comment -> Username
author :: Username
                       , Comment -> Maybe Text
authorFlairCSSClass :: Maybe Text
                       , Comment -> Maybe Text
authorFlairText :: Maybe Text
                       , Comment -> Text
body :: Text
                       , Comment -> Text
bodyHTML :: Text
                       , Comment -> Listing CommentID CommentReference
replies :: Listing CommentID CommentReference
                       , Comment -> UTCTime
created :: UTCTime
                       , Comment -> Maybe UTCTime
edited :: Maybe UTCTime
                       , Comment -> PostID
parentLink :: PostID
                       , Comment -> Maybe CommentID
inReplyTo :: Maybe CommentID }
  deriving (Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show, ReadPrec [Comment]
ReadPrec Comment
Int -> ReadS Comment
ReadS [Comment]
(Int -> ReadS Comment)
-> ReadS [Comment]
-> ReadPrec Comment
-> ReadPrec [Comment]
-> Read Comment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Comment]
$creadListPrec :: ReadPrec [Comment]
readPrec :: ReadPrec Comment
$creadPrec :: ReadPrec Comment
readList :: ReadS [Comment]
$creadList :: ReadS [Comment]
readsPrec :: Int -> ReadS Comment
$creadsPrec :: Int -> ReadS Comment
Read, Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: Comment -> Comment -> Bool
Eq)

instance Thing Comment where
  fullName :: Comment -> Text
fullName Comment
c = CommentID -> Text
forall a. Thing a => a -> Text
fullName (Comment -> CommentID
commentID Comment
c)

instance FromJSON Comment where
  parseJSON :: Value -> Parser Comment
parseJSON (Object Object
o) = do
    Object
o Object -> Text -> Parser ()
`ensureKind` Text
commentPrefix
    Object
d <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    CommentID
-> Maybe Integer
-> SubredditID
-> SubredditName
-> Integer
-> Bool
-> Username
-> Maybe Text
-> Maybe Text
-> Text
-> Text
-> Listing CommentID CommentReference
-> UTCTime
-> Maybe UTCTime
-> PostID
-> Maybe CommentID
-> Comment
Comment (CommentID
 -> Maybe Integer
 -> SubredditID
 -> SubredditName
 -> Integer
 -> Bool
 -> Username
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Text
 -> Listing CommentID CommentReference
 -> UTCTime
 -> Maybe UTCTime
 -> PostID
 -> Maybe CommentID
 -> Comment)
-> Parser CommentID
-> Parser
     (Maybe Integer
      -> SubredditID
      -> SubredditName
      -> Integer
      -> Bool
      -> Username
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
d Object -> Key -> Parser CommentID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser
  (Maybe Integer
   -> SubredditID
   -> SubredditName
   -> Integer
   -> Bool
   -> Username
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser (Maybe Integer)
-> Parser
     (SubredditID
      -> SubredditName
      -> Integer
      -> Bool
      -> Username
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"score"
            Parser
  (SubredditID
   -> SubredditName
   -> Integer
   -> Bool
   -> Username
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser SubredditID
-> Parser
     (SubredditName
      -> Integer
      -> Bool
      -> Username
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
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"
            Parser
  (SubredditName
   -> Integer
   -> Bool
   -> Username
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser SubredditName
-> Parser
     (Integer
      -> Bool
      -> Username
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
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
  (Integer
   -> Bool
   -> Username
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser Integer
-> Parser
     (Bool
      -> Username
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
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
   -> Username
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser Bool
-> Parser
     (Username
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
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
"saved"
            Parser
  (Username
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser Username
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
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
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
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
"author_flair_css_class"
            Parser
  (Maybe Text
   -> Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
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
"author_flair_text"
            Parser
  (Text
   -> Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser Text
-> Parser
     (Text
      -> Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Text
unescape (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
d Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body")
            Parser
  (Text
   -> Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser Text
-> Parser
     (Listing CommentID CommentReference
      -> UTCTime
      -> Maybe UTCTime
      -> PostID
      -> Maybe CommentID
      -> Comment)
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
"body_html"
            Parser
  (Listing CommentID CommentReference
   -> UTCTime
   -> Maybe UTCTime
   -> PostID
   -> Maybe CommentID
   -> Comment)
-> Parser (Listing CommentID CommentReference)
-> Parser
     (UTCTime -> Maybe UTCTime -> PostID -> Maybe CommentID -> Comment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
d Object -> Key -> Parser (Listing CommentID CommentReference)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"replies"
            Parser
  (UTCTime -> Maybe UTCTime -> PostID -> Maybe CommentID -> Comment)
-> Parser UTCTime
-> Parser (Maybe UTCTime -> PostID -> Maybe CommentID -> Comment)
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 (Maybe UTCTime -> PostID -> Maybe CommentID -> Comment)
-> Parser (Maybe UTCTime)
-> Parser (PostID -> Maybe CommentID -> Comment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((Integer -> UTCTime) -> Maybe Integer -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) (Maybe Integer -> Maybe UTCTime)
-> Parser (Maybe Integer) -> Parser (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
d Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"edited") Parser (Maybe UTCTime)
-> Parser (Maybe UTCTime) -> Parser (Maybe UTCTime)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe UTCTime -> Parser (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UTCTime
forall a. Maybe a
Nothing)
            Parser (PostID -> Maybe CommentID -> Comment)
-> Parser PostID -> Parser (Maybe CommentID -> Comment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser PostID
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser PostID) -> Parser Value -> Parser PostID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
d Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"link_id")
            Parser (Maybe CommentID -> Comment)
-> Parser (Maybe CommentID) -> Parser Comment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
d Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parent_id" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe CommentID))
-> Parser (Maybe CommentID)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Value
v -> (Value -> Parser CommentID)
-> Maybe Value -> Parser (Maybe CommentID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser CommentID
forall a. FromJSON a => Value -> Parser a
parseJSON Maybe Value
v Parser (Maybe CommentID)
-> Parser (Maybe CommentID) -> Parser (Maybe CommentID)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe CommentID -> Parser (Maybe CommentID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CommentID
forall a. Maybe a
Nothing)
  parseJSON Value
_ = Parser Comment
forall a. Monoid a => a
mempty

instance FromJSON (POSTWrapped Comment) where
  parseJSON :: Value -> Parser (POSTWrapped Comment)
parseJSON (Object Object
o) = do
    Vector Value
ts <- (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 (Vector Value)) -> Parser (Vector Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser (Vector Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"things")
    case Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList Vector Value
ts of
      [Value
c] -> Comment -> POSTWrapped Comment
forall a. a -> POSTWrapped a
POSTWrapped (Comment -> POSTWrapped Comment)
-> Parser Comment -> Parser (POSTWrapped Comment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Comment
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c
      [Value]
_ -> Parser (POSTWrapped Comment)
forall a. Monoid a => a
mempty
  parseJSON Value
_ = Parser (POSTWrapped Comment)
forall a. Monoid a => a
mempty

treeSubComments :: CommentReference -> [CommentReference]
treeSubComments :: CommentReference -> [CommentReference]
treeSubComments a :: CommentReference
a@(Actual Comment
c) = CommentReference
a CommentReference -> [CommentReference] -> [CommentReference]
forall a. a -> [a] -> [a]
: (CommentReference -> [CommentReference])
-> [CommentReference] -> [CommentReference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CommentReference -> [CommentReference]
treeSubComments ((\(Listing Maybe CommentID
_ Maybe CommentID
_ [CommentReference]
cs) -> [CommentReference]
cs) (Listing CommentID CommentReference -> [CommentReference])
-> Listing CommentID CommentReference -> [CommentReference]
forall a b. (a -> b) -> a -> b
$ Comment -> Listing CommentID CommentReference
replies Comment
c)
treeSubComments (Reference Integer
_ [CommentID]
rs) = (CommentID -> CommentReference)
-> [CommentID] -> [CommentReference]
forall a b. (a -> b) -> [a] -> [b]
map (\CommentID
r -> Integer -> [CommentID] -> CommentReference
Reference Integer
1 [CommentID
r]) [CommentID]
rs

isDeleted :: Comment -> Bool
isDeleted :: Comment -> Bool
isDeleted = (Username -> Username -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Username
Username Text
"[deleted]") (Username -> Bool) -> (Comment -> Username) -> Comment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> Username
author

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

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

type CommentListing = Listing CommentID Comment

commentPrefix :: Text
commentPrefix :: Text
commentPrefix = Text
"t1"