module Reddit.Types.Subreddit where

import Reddit.Parser
import Reddit.Types.Thing

import Control.Applicative
import Data.Aeson
import Data.Monoid
import Data.Text (Text)
import Network.API.Builder.Query
import Prelude
import qualified Data.Text as Text

newtype SubredditName = R Text
  deriving (Int -> SubredditName -> ShowS
[SubredditName] -> ShowS
SubredditName -> String
(Int -> SubredditName -> ShowS)
-> (SubredditName -> String)
-> ([SubredditName] -> ShowS)
-> Show SubredditName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubredditName] -> ShowS
$cshowList :: [SubredditName] -> ShowS
show :: SubredditName -> String
$cshow :: SubredditName -> String
showsPrec :: Int -> SubredditName -> ShowS
$cshowsPrec :: Int -> SubredditName -> ShowS
Show, ReadPrec [SubredditName]
ReadPrec SubredditName
Int -> ReadS SubredditName
ReadS [SubredditName]
(Int -> ReadS SubredditName)
-> ReadS [SubredditName]
-> ReadPrec SubredditName
-> ReadPrec [SubredditName]
-> Read SubredditName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubredditName]
$creadListPrec :: ReadPrec [SubredditName]
readPrec :: ReadPrec SubredditName
$creadPrec :: ReadPrec SubredditName
readList :: ReadS [SubredditName]
$creadList :: ReadS [SubredditName]
readsPrec :: Int -> ReadS SubredditName
$creadsPrec :: Int -> ReadS SubredditName
Read)

instance Eq SubredditName where
  R Text
x == :: SubredditName -> SubredditName -> Bool
== R Text
y = Text -> Text
Text.toCaseFold Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
Text.toCaseFold Text
y

instance Ord SubredditName where
  R Text
x compare :: SubredditName -> SubredditName -> Ordering
`compare` R Text
y = Text -> Text
Text.toCaseFold Text
x Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Text -> Text
Text.toCaseFold Text
y

instance ToQuery SubredditName where
  toQuery :: Text -> SubredditName -> [(Text, Text)]
toQuery Text
k (R Text
sub) = [(Text
k, Text
sub)]

instance FromJSON SubredditName where
  parseJSON :: Value -> Parser SubredditName
parseJSON Value
j = Text -> SubredditName
R (Text -> SubredditName) -> Parser Text -> Parser SubredditName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j

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

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

instance Thing SubredditID where
  fullName :: SubredditID -> Text
fullName (SubredditID Text
i) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
subredditPrefix, Text
"_", Text
i]

instance ToQuery SubredditID where
  toQuery :: Text -> SubredditID -> [(Text, Text)]
toQuery Text
k (SubredditID Text
v) = [(Text
k, Text
v)]

data Subreddit =
  Subreddit { Subreddit -> SubredditID
subredditID :: SubredditID
            , Subreddit -> SubredditName
name :: SubredditName
            , Subreddit -> Text
title :: Text
            , Subreddit -> Integer
subscribers :: Integer
            , Subreddit -> Maybe Bool
userIsBanned :: Maybe Bool }
  deriving (Int -> Subreddit -> ShowS
[Subreddit] -> ShowS
Subreddit -> String
(Int -> Subreddit -> ShowS)
-> (Subreddit -> String)
-> ([Subreddit] -> ShowS)
-> Show Subreddit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subreddit] -> ShowS
$cshowList :: [Subreddit] -> ShowS
show :: Subreddit -> String
$cshow :: Subreddit -> String
showsPrec :: Int -> Subreddit -> ShowS
$cshowsPrec :: Int -> Subreddit -> ShowS
Show, Subreddit -> Subreddit -> Bool
(Subreddit -> Subreddit -> Bool)
-> (Subreddit -> Subreddit -> Bool) -> Eq Subreddit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subreddit -> Subreddit -> Bool
$c/= :: Subreddit -> Subreddit -> Bool
== :: Subreddit -> Subreddit -> Bool
$c== :: Subreddit -> Subreddit -> Bool
Eq)

instance FromJSON Subreddit where
  parseJSON :: Value -> Parser Subreddit
parseJSON (Object Object
o) = do
    Object
o Object -> Text -> Parser ()
`ensureKind` Text
subredditPrefix
    Object
d <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    SubredditID
-> SubredditName -> Text -> Integer -> Maybe Bool -> Subreddit
Subreddit (SubredditID
 -> SubredditName -> Text -> Integer -> Maybe Bool -> Subreddit)
-> Parser SubredditID
-> Parser
     (SubredditName -> Text -> Integer -> Maybe Bool -> Subreddit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
d Object -> Key -> Parser SubredditID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
              Parser
  (SubredditName -> Text -> Integer -> Maybe Bool -> Subreddit)
-> Parser SubredditName
-> Parser (Text -> Integer -> Maybe Bool -> Subreddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> SubredditName
R (Text -> SubredditName) -> Parser Text -> Parser SubredditName
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
"display_name")
              Parser (Text -> Integer -> Maybe Bool -> Subreddit)
-> Parser Text -> Parser (Integer -> Maybe Bool -> Subreddit)
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 (Integer -> Maybe Bool -> Subreddit)
-> Parser Integer -> Parser (Maybe Bool -> Subreddit)
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
"subscribers"
              Parser (Maybe Bool -> Subreddit)
-> Parser (Maybe Bool) -> Parser Subreddit
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 a
.: Key
"user_is_banned"
  parseJSON Value
_ = Parser Subreddit
forall a. Monoid a => a
mempty

instance Thing Subreddit where
  fullName :: Subreddit -> Text
fullName Subreddit
sub = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
subredditPrefix, Text
"_", Text
s]
    where SubredditID Text
s = Subreddit -> SubredditID
subredditID Subreddit
sub

subredditPrefix :: Text
subredditPrefix :: Text
subredditPrefix = Text
"t5"