module Reddit.Types.Listing where

import Reddit.Parser

import Control.Applicative
import Data.Aeson
import Data.Traversable
import Data.Semigroup
import Network.API.Builder.Query
import Prelude

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

instance ToQuery ListingType where
  toQuery :: Text -> ListingType -> [(Text, Text)]
toQuery Text
k ListingType
t = (Text, Text) -> [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Text) -> [(Text, Text)]) -> (Text, Text) -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (,) Text
k (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ case ListingType
t of
    ListingType
Hot -> Text
"hot"
    ListingType
New -> Text
"new"
    ListingType
Rising -> Text
"rising"
    ListingType
Controversial -> Text
"controversial"
    ListingType
Top -> Text
"top"

data Listing t a = Listing { Listing t a -> Maybe t
before :: Maybe t
                           , Listing t a -> Maybe t
after :: Maybe t
                           , Listing t a -> [a]
contents :: [a] }
  deriving (Int -> Listing t a -> ShowS
[Listing t a] -> ShowS
Listing t a -> String
(Int -> Listing t a -> ShowS)
-> (Listing t a -> String)
-> ([Listing t a] -> ShowS)
-> Show (Listing t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t a. (Show t, Show a) => Int -> Listing t a -> ShowS
forall t a. (Show t, Show a) => [Listing t a] -> ShowS
forall t a. (Show t, Show a) => Listing t a -> String
showList :: [Listing t a] -> ShowS
$cshowList :: forall t a. (Show t, Show a) => [Listing t a] -> ShowS
show :: Listing t a -> String
$cshow :: forall t a. (Show t, Show a) => Listing t a -> String
showsPrec :: Int -> Listing t a -> ShowS
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> Listing t a -> ShowS
Show, ReadPrec [Listing t a]
ReadPrec (Listing t a)
Int -> ReadS (Listing t a)
ReadS [Listing t a]
(Int -> ReadS (Listing t a))
-> ReadS [Listing t a]
-> ReadPrec (Listing t a)
-> ReadPrec [Listing t a]
-> Read (Listing t a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall t a. (Read t, Read a) => ReadPrec [Listing t a]
forall t a. (Read t, Read a) => ReadPrec (Listing t a)
forall t a. (Read t, Read a) => Int -> ReadS (Listing t a)
forall t a. (Read t, Read a) => ReadS [Listing t a]
readListPrec :: ReadPrec [Listing t a]
$creadListPrec :: forall t a. (Read t, Read a) => ReadPrec [Listing t a]
readPrec :: ReadPrec (Listing t a)
$creadPrec :: forall t a. (Read t, Read a) => ReadPrec (Listing t a)
readList :: ReadS [Listing t a]
$creadList :: forall t a. (Read t, Read a) => ReadS [Listing t a]
readsPrec :: Int -> ReadS (Listing t a)
$creadsPrec :: forall t a. (Read t, Read a) => Int -> ReadS (Listing t a)
Read, Listing t a -> Listing t a -> Bool
(Listing t a -> Listing t a -> Bool)
-> (Listing t a -> Listing t a -> Bool) -> Eq (Listing t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t a. (Eq t, Eq a) => Listing t a -> Listing t a -> Bool
/= :: Listing t a -> Listing t a -> Bool
$c/= :: forall t a. (Eq t, Eq a) => Listing t a -> Listing t a -> Bool
== :: Listing t a -> Listing t a -> Bool
$c== :: forall t a. (Eq t, Eq a) => Listing t a -> Listing t a -> Bool
Eq)

instance Functor (Listing t) where
  fmap :: (a -> b) -> Listing t a -> Listing t b
fmap a -> b
f (Listing Maybe t
b Maybe t
a [a]
x) = Maybe t -> Maybe t -> [b] -> Listing t b
forall t a. Maybe t -> Maybe t -> [a] -> Listing t a
Listing Maybe t
b Maybe t
a ((a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
x)

instance Ord t => Semigroup (Listing t a) where
  Listing Maybe t
a Maybe t
b [a]
cs <> :: Listing t a -> Listing t a -> Listing t a
<> Listing Maybe t
d Maybe t
e [a]
fs =
    Maybe t -> Maybe t -> [a] -> Listing t a
forall t a. Maybe t -> Maybe t -> [a] -> Listing t a
Listing (Maybe t -> Maybe t -> Maybe t
forall a. Ord a => a -> a -> a
max Maybe t
a Maybe t
d) (Maybe t -> Maybe t -> Maybe t
forall a. Ord a => a -> a -> a
min Maybe t
b Maybe t
e) ([a]
cs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
fs)

instance Ord t => Monoid (Listing t a) where
  mappend :: Listing t a -> Listing t a -> Listing t a
mappend = Listing t a -> Listing t a -> Listing t a
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Listing t a
mempty = Maybe t -> Maybe t -> [a] -> Listing t a
forall t a. Maybe t -> Maybe t -> [a] -> Listing t a
Listing Maybe t
forall a. Maybe a
Nothing Maybe t
forall a. Maybe a
Nothing []

instance (FromJSON t, FromJSON a) => FromJSON (Listing t a) where
  parseJSON :: Value -> Parser (Listing t a)
parseJSON (Object Object
o) = do
    Object
o Object -> Text -> Parser ()
`ensureKind` Text
"Listing"
    Object
d <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    Maybe t -> Maybe t -> [a] -> Listing t a
forall t a. Maybe t -> Maybe t -> [a] -> Listing t a
Listing (Maybe t -> Maybe t -> [a] -> Listing t a)
-> Parser (Maybe t) -> Parser (Maybe t -> [a] -> Listing t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
d Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"before" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe t)) -> Parser (Maybe t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser t) -> Maybe Value -> Parser (Maybe t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser t
forall a. FromJSON a => Value -> Parser a
parseJSON)
            Parser (Maybe t -> [a] -> Listing t a)
-> Parser (Maybe t) -> Parser ([a] -> Listing t a)
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
"after" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe t)) -> Parser (Maybe t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser t) -> Maybe Value -> Parser (Maybe t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser t
forall a. FromJSON a => Value -> Parser a
parseJSON)
            Parser ([a] -> Listing t a) -> Parser [a] -> Parser (Listing t a)
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 [a]) -> Parser [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser [a]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"children"))
  parseJSON (String Text
"") = Listing t a -> Parser (Listing t a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Listing t a -> Parser (Listing t a))
-> Listing t a -> Parser (Listing t a)
forall a b. (a -> b) -> a -> b
$ Maybe t -> Maybe t -> [a] -> Listing t a
forall t a. Maybe t -> Maybe t -> [a] -> Listing t a
Listing Maybe t
forall a. Maybe a
Nothing Maybe t
forall a. Maybe a
Nothing []
  parseJSON Value
Null = Listing t a -> Parser (Listing t a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Listing t a -> Parser (Listing t a))
-> Listing t a -> Parser (Listing t a)
forall a b. (a -> b) -> a -> b
$ Maybe t -> Maybe t -> [a] -> Listing t a
forall t a. Maybe t -> Maybe t -> [a] -> Listing t a
Listing Maybe t
forall a. Maybe a
Nothing Maybe t
forall a. Maybe a
Nothing []
  parseJSON Value
_ = Parser (Listing t a)
forall a. Monoid a => a
mempty