{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Network.Reddit.Types.Live
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Live
    ( LiveThread(..)
    , LiveThreadID(LiveThreadID)
    , PostableLiveThread(..)
    , NewLiveThread
    , UpdatedLiveThread
    , liveThreadToPostable
    , mkNewLiveThread
    , PostedLiveThread
    , LiveUpdate(..)
    , LiveUpdateID(LiveUpdateID)
    , LiveUpdateEmbed(..)
    , LiveContributor(..)
    , LiveContributorList(..)
    , LivePermission(..)
    , LiveReportType(..)
    , LiveState(..)
    ) where

import           Control.Monad                 ( (<=<) )

import           Data.Aeson
                 ( (.!=)
                 , (.:)
                 , (.:?)
                 , FromJSON(parseJSON)
                 , Options(constructorTagModifier)
                 , Value(Object)
                 , defaultOptions
                 , genericParseJSON
                 , withArray
                 , withObject
                 , withText
                 )
import           Data.Char                     ( toLower )
import           Data.Coerce                   ( coerce )
import           Data.Foldable                 ( asum )
import           Data.Maybe                    ( fromMaybe )
import           Data.Sequence                 ( Seq )
import           Data.Text                     ( Text )
import           Data.Time                     ( UTCTime )

import           GHC.Exts                      ( IsList(..) )
import           GHC.Generics                  ( Generic )

import           Network.Reddit.Types.Account
import           Network.Reddit.Types.Internal

import           Web.FormUrlEncoded            ( ToForm(toForm) )
import           Web.HttpApiData               ( ToHttpApiData(..)
                                               , showTextData
                                               )

-- | An existing Reddit live thread. It may be currently live or already
-- complete
data LiveThread = LiveThread
    { LiveThread -> LiveThreadID
liveThreadID    :: LiveThreadID
    , LiveThread -> Title
title           :: Title
    , LiveThread -> Maybe Title
description     :: Maybe Body
    , LiveThread -> Maybe Title
descriptionHTML :: Maybe Body
    , LiveThread -> Maybe Title
resources       :: Maybe Body
    , LiveThread -> Maybe Title
resourcesHTML   :: Maybe Body
    , LiveThread -> UTCTime
created         :: UTCTime
      -- | The current number of viewers; will be @Nothing@ if the
      -- @liveState@ is 'Complete'
    , LiveThread -> Maybe Integer
viewerCount     :: Maybe Integer
    , LiveThread -> LiveState
liveState       :: LiveState
    , LiveThread -> Bool
nsfw            :: Bool
      -- | If the thread is still live, this will allow you to connect to
      -- a websocket server to receive live updates as the thread progresses
    , LiveThread -> Maybe Title
websocketURL    :: Maybe URL
    }
    deriving stock ( Int -> LiveThread -> ShowS
[LiveThread] -> ShowS
LiveThread -> String
(Int -> LiveThread -> ShowS)
-> (LiveThread -> String)
-> ([LiveThread] -> ShowS)
-> Show LiveThread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveThread] -> ShowS
$cshowList :: [LiveThread] -> ShowS
show :: LiveThread -> String
$cshow :: LiveThread -> String
showsPrec :: Int -> LiveThread -> ShowS
$cshowsPrec :: Int -> LiveThread -> ShowS
Show, LiveThread -> LiveThread -> Bool
(LiveThread -> LiveThread -> Bool)
-> (LiveThread -> LiveThread -> Bool) -> Eq LiveThread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveThread -> LiveThread -> Bool
$c/= :: LiveThread -> LiveThread -> Bool
== :: LiveThread -> LiveThread -> Bool
$c== :: LiveThread -> LiveThread -> Bool
Eq, (forall x. LiveThread -> Rep LiveThread x)
-> (forall x. Rep LiveThread x -> LiveThread) -> Generic LiveThread
forall x. Rep LiveThread x -> LiveThread
forall x. LiveThread -> Rep LiveThread x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveThread x -> LiveThread
$cfrom :: forall x. LiveThread -> Rep LiveThread x
Generic )

instance FromJSON LiveThread where
    parseJSON :: Value -> Parser LiveThread
parseJSON = RedditKind
-> String
-> (Object -> Parser LiveThread)
-> Value
-> Parser LiveThread
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
LiveThreadKind String
"LiveThread" ((Object -> Parser LiveThread) -> Value -> Parser LiveThread)
-> (Object -> Parser LiveThread) -> Value -> Parser LiveThread
forall a b. (a -> b) -> a -> b
$ \Object
o -> LiveThreadID
-> Title
-> Maybe Title
-> Maybe Title
-> Maybe Title
-> Maybe Title
-> UTCTime
-> Maybe Integer
-> LiveState
-> Bool
-> Maybe Title
-> LiveThread
LiveThread
        (LiveThreadID
 -> Title
 -> Maybe Title
 -> Maybe Title
 -> Maybe Title
 -> Maybe Title
 -> UTCTime
 -> Maybe Integer
 -> LiveState
 -> Bool
 -> Maybe Title
 -> LiveThread)
-> Parser LiveThreadID
-> Parser
     (Title
      -> Maybe Title
      -> Maybe Title
      -> Maybe Title
      -> Maybe Title
      -> UTCTime
      -> Maybe Integer
      -> LiveState
      -> Bool
      -> Maybe Title
      -> LiveThread)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Title -> Parser LiveThreadID
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"id"
        Parser
  (Title
   -> Maybe Title
   -> Maybe Title
   -> Maybe Title
   -> Maybe Title
   -> UTCTime
   -> Maybe Integer
   -> LiveState
   -> Bool
   -> Maybe Title
   -> LiveThread)
-> Parser Title
-> Parser
     (Maybe Title
      -> Maybe Title
      -> Maybe Title
      -> Maybe Title
      -> UTCTime
      -> Maybe Integer
      -> LiveState
      -> Bool
      -> Maybe Title
      -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"title"
        Parser
  (Maybe Title
   -> Maybe Title
   -> Maybe Title
   -> Maybe Title
   -> UTCTime
   -> Maybe Integer
   -> LiveState
   -> Bool
   -> Maybe Title
   -> LiveThread)
-> Parser (Maybe Title)
-> Parser
     (Maybe Title
      -> Maybe Title
      -> Maybe Title
      -> UTCTime
      -> Maybe Integer
      -> LiveState
      -> Bool
      -> Maybe Title
      -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Title -> Parser (Maybe Title)
forall a. FromJSON a => Title -> Parser (Maybe a)
nothingTxtNull (Title -> Parser (Maybe Title))
-> Parser Title -> Parser (Maybe Title)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"description")
        Parser
  (Maybe Title
   -> Maybe Title
   -> Maybe Title
   -> UTCTime
   -> Maybe Integer
   -> LiveState
   -> Bool
   -> Maybe Title
   -> LiveThread)
-> Parser (Maybe Title)
-> Parser
     (Maybe Title
      -> Maybe Title
      -> UTCTime
      -> Maybe Integer
      -> LiveState
      -> Bool
      -> Maybe Title
      -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Title -> Parser (Maybe Title)
forall a. FromJSON a => Title -> Parser (Maybe a)
nothingTxtNull (Title -> Parser (Maybe Title))
-> Parser Title -> Parser (Maybe Title)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"description_html")
        Parser
  (Maybe Title
   -> Maybe Title
   -> UTCTime
   -> Maybe Integer
   -> LiveState
   -> Bool
   -> Maybe Title
   -> LiveThread)
-> Parser (Maybe Title)
-> Parser
     (Maybe Title
      -> UTCTime
      -> Maybe Integer
      -> LiveState
      -> Bool
      -> Maybe Title
      -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Title -> Parser (Maybe Title)
forall a. FromJSON a => Title -> Parser (Maybe a)
nothingTxtNull (Title -> Parser (Maybe Title))
-> Parser Title -> Parser (Maybe Title)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"resources")
        Parser
  (Maybe Title
   -> UTCTime
   -> Maybe Integer
   -> LiveState
   -> Bool
   -> Maybe Title
   -> LiveThread)
-> Parser (Maybe Title)
-> Parser
     (UTCTime
      -> Maybe Integer -> LiveState -> Bool -> Maybe Title -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Title -> Parser (Maybe Title)
forall a. FromJSON a => Title -> Parser (Maybe a)
nothingTxtNull (Title -> Parser (Maybe Title))
-> Parser Title -> Parser (Maybe Title)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"resources_html")
        Parser
  (UTCTime
   -> Maybe Integer -> LiveState -> Bool -> Maybe Title -> LiveThread)
-> Parser UTCTime
-> Parser
     (Maybe Integer -> LiveState -> Bool -> Maybe Title -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Title -> Parser Integer
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"created_utc")
        Parser
  (Maybe Integer -> LiveState -> Bool -> Maybe Title -> LiveThread)
-> Parser (Maybe Integer)
-> Parser (LiveState -> Bool -> Maybe Title -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"viewer_count"
        Parser (LiveState -> Bool -> Maybe Title -> LiveThread)
-> Parser LiveState -> Parser (Bool -> Maybe Title -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser LiveState
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"state"
        Parser (Bool -> Maybe Title -> LiveThread)
-> Parser Bool -> Parser (Maybe Title -> LiveThread)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser Bool
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"nsfw"
        Parser (Maybe Title -> LiveThread)
-> Parser (Maybe Title) -> Parser LiveThread
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"websocket_url"

-- The endpoints that list @LiveThread@s are a @Listing@, but there are no
-- additional options that can be passed to them. This dummy instance at least
-- allows using a @Listing ... LiveThread@ with existing convenience actions
instance Paginable LiveThread where
    type PaginateOptions LiveThread = ()

    type PaginateThing LiveThread = LiveThreadID

    defaultOpts :: PaginateOptions LiveThread
defaultOpts = ()

    optsToForm :: PaginateOptions LiveThread -> Form
optsToForm PaginateOptions LiveThread
_ = Form
forall a. Monoid a => a
mempty

    getFullname :: LiveThread -> PaginateThing LiveThread
getFullname LiveThread { LiveThreadID
liveThreadID :: LiveThreadID
$sel:liveThreadID:LiveThread :: LiveThread -> LiveThreadID
liveThreadID } = PaginateThing LiveThread
LiveThreadID
liveThreadID

-- | ID for a single 'LiveThread'
newtype LiveThreadID = LiveThreadID Text
    deriving stock ( Int -> LiveThreadID -> ShowS
[LiveThreadID] -> ShowS
LiveThreadID -> String
(Int -> LiveThreadID -> ShowS)
-> (LiveThreadID -> String)
-> ([LiveThreadID] -> ShowS)
-> Show LiveThreadID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveThreadID] -> ShowS
$cshowList :: [LiveThreadID] -> ShowS
show :: LiveThreadID -> String
$cshow :: LiveThreadID -> String
showsPrec :: Int -> LiveThreadID -> ShowS
$cshowsPrec :: Int -> LiveThreadID -> ShowS
Show, (forall x. LiveThreadID -> Rep LiveThreadID x)
-> (forall x. Rep LiveThreadID x -> LiveThreadID)
-> Generic LiveThreadID
forall x. Rep LiveThreadID x -> LiveThreadID
forall x. LiveThreadID -> Rep LiveThreadID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveThreadID x -> LiveThreadID
$cfrom :: forall x. LiveThreadID -> Rep LiveThreadID x
Generic )
    deriving newtype ( LiveThreadID -> LiveThreadID -> Bool
(LiveThreadID -> LiveThreadID -> Bool)
-> (LiveThreadID -> LiveThreadID -> Bool) -> Eq LiveThreadID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveThreadID -> LiveThreadID -> Bool
$c/= :: LiveThreadID -> LiveThreadID -> Bool
== :: LiveThreadID -> LiveThreadID -> Bool
$c== :: LiveThreadID -> LiveThreadID -> Bool
Eq, LiveThreadID -> ByteString
LiveThreadID -> Builder
LiveThreadID -> Title
(LiveThreadID -> Title)
-> (LiveThreadID -> Builder)
-> (LiveThreadID -> ByteString)
-> (LiveThreadID -> Title)
-> ToHttpApiData LiveThreadID
forall a.
(a -> Title)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Title)
-> ToHttpApiData a
toQueryParam :: LiveThreadID -> Title
$ctoQueryParam :: LiveThreadID -> Title
toHeader :: LiveThreadID -> ByteString
$ctoHeader :: LiveThreadID -> ByteString
toEncodedUrlPiece :: LiveThreadID -> Builder
$ctoEncodedUrlPiece :: LiveThreadID -> Builder
toUrlPiece :: LiveThreadID -> Title
$ctoUrlPiece :: LiveThreadID -> Title
ToHttpApiData )

instance FromJSON LiveThreadID where
    parseJSON :: Value -> Parser LiveThreadID
parseJSON =
        String
-> (Title -> Parser LiveThreadID) -> Value -> Parser LiveThreadID
forall a. String -> (Title -> Parser a) -> Value -> Parser a
withText String
"LiveThreadID" ((Title -> Parser LiveThreadID) -> Value -> Parser LiveThreadID)
-> (Title -> Parser LiveThreadID) -> Value -> Parser LiveThreadID
forall a b. (a -> b) -> a -> b
$ Parser Title -> Parser LiveThreadID
coerce (Parser Title -> Parser LiveThreadID)
-> (Title -> Parser Title) -> Title -> Parser LiveThreadID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedditKind -> Title -> Parser Title
dropTypePrefix RedditKind
LiveThreadKind

instance Thing LiveThreadID where
    fullname :: LiveThreadID -> Title
fullname (LiveThreadID Title
ltid) = RedditKind -> Title -> Title
prependType RedditKind
LiveThreadKind Title
ltid

-- | The state of the 'LiveThread'
data LiveState
    = Current
    | Complete
    deriving stock ( Int -> LiveState -> ShowS
[LiveState] -> ShowS
LiveState -> String
(Int -> LiveState -> ShowS)
-> (LiveState -> String)
-> ([LiveState] -> ShowS)
-> Show LiveState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveState] -> ShowS
$cshowList :: [LiveState] -> ShowS
show :: LiveState -> String
$cshow :: LiveState -> String
showsPrec :: Int -> LiveState -> ShowS
$cshowsPrec :: Int -> LiveState -> ShowS
Show, LiveState -> LiveState -> Bool
(LiveState -> LiveState -> Bool)
-> (LiveState -> LiveState -> Bool) -> Eq LiveState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveState -> LiveState -> Bool
$c/= :: LiveState -> LiveState -> Bool
== :: LiveState -> LiveState -> Bool
$c== :: LiveState -> LiveState -> Bool
Eq, (forall x. LiveState -> Rep LiveState x)
-> (forall x. Rep LiveState x -> LiveState) -> Generic LiveState
forall x. Rep LiveState x -> LiveState
forall x. LiveState -> Rep LiveState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveState x -> LiveState
$cfrom :: forall x. LiveState -> Rep LiveState x
Generic )

instance FromJSON LiveState where
    parseJSON :: Value -> Parser LiveState
parseJSON = String -> (Title -> Parser LiveState) -> Value -> Parser LiveState
forall a. String -> (Title -> Parser a) -> Value -> Parser a
withText String
"LiveState" ((Title -> Parser LiveState) -> Value -> Parser LiveState)
-> (Title -> Parser LiveState) -> Value -> Parser LiveState
forall a b. (a -> b) -> a -> b
$ \case
        Title
"live"     -> LiveState -> Parser LiveState
forall (f :: * -> *) a. Applicative f => a -> f a
pure LiveState
Current
        Title
"complete" -> LiveState -> Parser LiveState
forall (f :: * -> *) a. Applicative f => a -> f a
pure LiveState
Complete
        Title
_          -> Parser LiveState
forall a. Monoid a => a
mempty

-- | Data to create a new 'LiveThread' or update an existing one. In the latter
-- case, see 'liveThreadToPostable' for conversion
data PostableLiveThread = PostableLiveThread
    { PostableLiveThread -> Title
title       :: Title
      -- | Markdown-formatted; if @Nothing@, defaults to an empty string
    , PostableLiveThread -> Maybe Title
description :: Maybe Body
      -- | Markdown-formatted; if @Nothing@, defaults to an empty string
    , PostableLiveThread -> Maybe Title
resources   :: Maybe Body
    , PostableLiveThread -> Bool
nsfw        :: Bool
    }
    deriving stock ( Int -> PostableLiveThread -> ShowS
[PostableLiveThread] -> ShowS
PostableLiveThread -> String
(Int -> PostableLiveThread -> ShowS)
-> (PostableLiveThread -> String)
-> ([PostableLiveThread] -> ShowS)
-> Show PostableLiveThread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostableLiveThread] -> ShowS
$cshowList :: [PostableLiveThread] -> ShowS
show :: PostableLiveThread -> String
$cshow :: PostableLiveThread -> String
showsPrec :: Int -> PostableLiveThread -> ShowS
$cshowsPrec :: Int -> PostableLiveThread -> ShowS
Show, PostableLiveThread -> PostableLiveThread -> Bool
(PostableLiveThread -> PostableLiveThread -> Bool)
-> (PostableLiveThread -> PostableLiveThread -> Bool)
-> Eq PostableLiveThread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostableLiveThread -> PostableLiveThread -> Bool
$c/= :: PostableLiveThread -> PostableLiveThread -> Bool
== :: PostableLiveThread -> PostableLiveThread -> Bool
$c== :: PostableLiveThread -> PostableLiveThread -> Bool
Eq, (forall x. PostableLiveThread -> Rep PostableLiveThread x)
-> (forall x. Rep PostableLiveThread x -> PostableLiveThread)
-> Generic PostableLiveThread
forall x. Rep PostableLiveThread x -> PostableLiveThread
forall x. PostableLiveThread -> Rep PostableLiveThread x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostableLiveThread x -> PostableLiveThread
$cfrom :: forall x. PostableLiveThread -> Rep PostableLiveThread x
Generic )

instance ToForm PostableLiveThread where
    toForm :: PostableLiveThread -> Form
toForm PostableLiveThread { Bool
Maybe Title
Title
nsfw :: Bool
resources :: Maybe Title
description :: Maybe Title
title :: Title
$sel:nsfw:PostableLiveThread :: PostableLiveThread -> Bool
$sel:resources:PostableLiveThread :: PostableLiveThread -> Maybe Title
$sel:description:PostableLiveThread :: PostableLiveThread -> Maybe Title
$sel:title:PostableLiveThread :: PostableLiveThread -> Title
.. } =
        [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList [ (Title
"title", Title
title)
                 , (Title
"description", Title -> Maybe Title -> Title
forall a. a -> Maybe a -> a
fromMaybe Title
forall a. Monoid a => a
mempty Maybe Title
description)
                 , (Title
"resources", Title -> Maybe Title -> Title
forall a. a -> Maybe a -> a
fromMaybe Title
forall a. Monoid a => a
mempty Maybe Title
description)
                 , (Title
"nsfw", Bool -> Title
forall a. ToHttpApiData a => a -> Title
toQueryParam Bool
nsfw)
                 , (Title
"api_type", Title
"json")
                 ]

-- | Type synonym for creating new live threads
type NewLiveThread = PostableLiveThread

-- | Type synonym for updating existing live threads
type UpdatedLiveThread = PostableLiveThread

-- | Create a 'NewLiveThread' with default values for most fields
mkNewLiveThread :: Title -> NewLiveThread
mkNewLiveThread :: Title -> PostableLiveThread
mkNewLiveThread Title
title = PostableLiveThread :: Title -> Maybe Title -> Maybe Title -> Bool -> PostableLiveThread
PostableLiveThread
    { Title
title :: Title
$sel:title:PostableLiveThread :: Title
title
    , $sel:description:PostableLiveThread :: Maybe Title
description = Maybe Title
forall a. Maybe a
Nothing
    , $sel:resources:PostableLiveThread :: Maybe Title
resources   = Maybe Title
forall a. Maybe a
Nothing  --
    , $sel:nsfw:PostableLiveThread :: Bool
nsfw        = Bool
False
    }

-- | Convenience function to transform an existing 'LiveThread' into
-- a 'PostableLiveThread', which may be used in updates
liveThreadToPostable :: LiveThread -> UpdatedLiveThread
liveThreadToPostable :: LiveThread -> PostableLiveThread
liveThreadToPostable LiveThread { Bool
Maybe Integer
Maybe Title
Title
UTCTime
LiveState
LiveThreadID
websocketURL :: Maybe Title
nsfw :: Bool
liveState :: LiveState
viewerCount :: Maybe Integer
created :: UTCTime
resourcesHTML :: Maybe Title
resources :: Maybe Title
descriptionHTML :: Maybe Title
description :: Maybe Title
title :: Title
liveThreadID :: LiveThreadID
$sel:websocketURL:LiveThread :: LiveThread -> Maybe Title
$sel:nsfw:LiveThread :: LiveThread -> Bool
$sel:liveState:LiveThread :: LiveThread -> LiveState
$sel:viewerCount:LiveThread :: LiveThread -> Maybe Integer
$sel:created:LiveThread :: LiveThread -> UTCTime
$sel:resourcesHTML:LiveThread :: LiveThread -> Maybe Title
$sel:resources:LiveThread :: LiveThread -> Maybe Title
$sel:descriptionHTML:LiveThread :: LiveThread -> Maybe Title
$sel:description:LiveThread :: LiveThread -> Maybe Title
$sel:title:LiveThread :: LiveThread -> Title
$sel:liveThreadID:LiveThread :: LiveThread -> LiveThreadID
.. } = PostableLiveThread :: Title -> Maybe Title -> Maybe Title -> Bool -> PostableLiveThread
PostableLiveThread { Bool
Maybe Title
Title
nsfw :: Bool
resources :: Maybe Title
description :: Maybe Title
title :: Title
$sel:nsfw:PostableLiveThread :: Bool
$sel:resources:PostableLiveThread :: Maybe Title
$sel:description:PostableLiveThread :: Maybe Title
$sel:title:PostableLiveThread :: Title
.. }

-- | Wrapper for parsing the ID returned from POSTing a livethred
newtype PostedLiveThread = PostedLiveThread LiveThreadID
    deriving stock ( Int -> PostedLiveThread -> ShowS
[PostedLiveThread] -> ShowS
PostedLiveThread -> String
(Int -> PostedLiveThread -> ShowS)
-> (PostedLiveThread -> String)
-> ([PostedLiveThread] -> ShowS)
-> Show PostedLiveThread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostedLiveThread] -> ShowS
$cshowList :: [PostedLiveThread] -> ShowS
show :: PostedLiveThread -> String
$cshow :: PostedLiveThread -> String
showsPrec :: Int -> PostedLiveThread -> ShowS
$cshowsPrec :: Int -> PostedLiveThread -> ShowS
Show, (forall x. PostedLiveThread -> Rep PostedLiveThread x)
-> (forall x. Rep PostedLiveThread x -> PostedLiveThread)
-> Generic PostedLiveThread
forall x. Rep PostedLiveThread x -> PostedLiveThread
forall x. PostedLiveThread -> Rep PostedLiveThread x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostedLiveThread x -> PostedLiveThread
$cfrom :: forall x. PostedLiveThread -> Rep PostedLiveThread x
Generic )

instance FromJSON PostedLiveThread where
    parseJSON :: Value -> Parser PostedLiveThread
parseJSON = String
-> (Object -> Parser PostedLiveThread)
-> Value
-> Parser PostedLiveThread
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PostedLiveThread"
        ((Object -> Parser PostedLiveThread)
 -> Value -> Parser PostedLiveThread)
-> (Object -> Parser PostedLiveThread)
-> Value
-> Parser PostedLiveThread
forall a b. (a -> b) -> a -> b
$ (LiveThreadID -> PostedLiveThread)
-> Parser LiveThreadID -> Parser PostedLiveThread
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LiveThreadID -> PostedLiveThread
PostedLiveThread (Parser LiveThreadID -> Parser PostedLiveThread)
-> (Object -> Parser LiveThreadID)
-> Object
-> Parser PostedLiveThread
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Object -> Title -> Parser LiveThreadID
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"id") (Object -> Parser LiveThreadID)
-> (Object -> Parser Object) -> Object -> Parser LiveThreadID
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Object -> Title -> Parser Object
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"data") (Object -> Parser Object)
-> (Object -> Parser Object) -> Object -> Parser Object
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Object -> Title -> Parser Object
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"json"))

-- | An individual update in a 'LiveThread'
data LiveUpdate = LiveUpdate
    { LiveUpdate -> LiveUpdateID
liveUpdateID :: LiveUpdateID
    , LiveUpdate -> Username
author       :: Username
    , LiveUpdate -> Title
body         :: Body
    , LiveUpdate -> Title
bodyHTML     :: Body
    , LiveUpdate -> Bool
stricken     :: Bool
    , LiveUpdate -> Seq LiveUpdateEmbed
embeds       :: Seq LiveUpdateEmbed
    }
    deriving stock ( Int -> LiveUpdate -> ShowS
[LiveUpdate] -> ShowS
LiveUpdate -> String
(Int -> LiveUpdate -> ShowS)
-> (LiveUpdate -> String)
-> ([LiveUpdate] -> ShowS)
-> Show LiveUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveUpdate] -> ShowS
$cshowList :: [LiveUpdate] -> ShowS
show :: LiveUpdate -> String
$cshow :: LiveUpdate -> String
showsPrec :: Int -> LiveUpdate -> ShowS
$cshowsPrec :: Int -> LiveUpdate -> ShowS
Show, LiveUpdate -> LiveUpdate -> Bool
(LiveUpdate -> LiveUpdate -> Bool)
-> (LiveUpdate -> LiveUpdate -> Bool) -> Eq LiveUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveUpdate -> LiveUpdate -> Bool
$c/= :: LiveUpdate -> LiveUpdate -> Bool
== :: LiveUpdate -> LiveUpdate -> Bool
$c== :: LiveUpdate -> LiveUpdate -> Bool
Eq, (forall x. LiveUpdate -> Rep LiveUpdate x)
-> (forall x. Rep LiveUpdate x -> LiveUpdate) -> Generic LiveUpdate
forall x. Rep LiveUpdate x -> LiveUpdate
forall x. LiveUpdate -> Rep LiveUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveUpdate x -> LiveUpdate
$cfrom :: forall x. LiveUpdate -> Rep LiveUpdate x
Generic )

instance FromJSON LiveUpdate where
    parseJSON :: Value -> Parser LiveUpdate
parseJSON = RedditKind
-> String
-> (Object -> Parser LiveUpdate)
-> Value
-> Parser LiveUpdate
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
LiveUpdateKind String
"LiveUpdate" ((Object -> Parser LiveUpdate) -> Value -> Parser LiveUpdate)
-> (Object -> Parser LiveUpdate) -> Value -> Parser LiveUpdate
forall a b. (a -> b) -> a -> b
$ \Object
o -> LiveUpdateID
-> Username
-> Title
-> Title
-> Bool
-> Seq LiveUpdateEmbed
-> LiveUpdate
LiveUpdate
        (LiveUpdateID
 -> Username
 -> Title
 -> Title
 -> Bool
 -> Seq LiveUpdateEmbed
 -> LiveUpdate)
-> Parser LiveUpdateID
-> Parser
     (Username
      -> Title -> Title -> Bool -> Seq LiveUpdateEmbed -> LiveUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Title -> Parser LiveUpdateID
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"name"
        Parser
  (Username
   -> Title -> Title -> Bool -> Seq LiveUpdateEmbed -> LiveUpdate)
-> Parser Username
-> Parser
     (Title -> Title -> Bool -> Seq LiveUpdateEmbed -> LiveUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser (Maybe Username)
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"author" Parser (Maybe Username) -> Username -> Parser Username
forall a. Parser (Maybe a) -> a -> Parser a
.!= Username
DeletedUser
        Parser
  (Title -> Title -> Bool -> Seq LiveUpdateEmbed -> LiveUpdate)
-> Parser Title
-> Parser (Title -> Bool -> Seq LiveUpdateEmbed -> LiveUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"body"
        Parser (Title -> Bool -> Seq LiveUpdateEmbed -> LiveUpdate)
-> Parser Title
-> Parser (Bool -> Seq LiveUpdateEmbed -> LiveUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"body_html"
        Parser (Bool -> Seq LiveUpdateEmbed -> LiveUpdate)
-> Parser Bool -> Parser (Seq LiveUpdateEmbed -> LiveUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser Bool
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"stricken"
        Parser (Seq LiveUpdateEmbed -> LiveUpdate)
-> Parser (Seq LiveUpdateEmbed) -> Parser LiveUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser (Seq LiveUpdateEmbed)
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"embeds"

-- The endpoints that list @LiveUpdate@s are a @Listing@, but there are no
-- additional options that can be passed to them. This dummy instance at least
-- allows using a @Listing ... LiveUpdate@ with existing convenience actions
instance Paginable LiveUpdate where
    type PaginateOptions LiveUpdate = ()

    type PaginateThing LiveUpdate = LiveUpdateID

    defaultOpts :: PaginateOptions LiveUpdate
defaultOpts = ()

    optsToForm :: PaginateOptions LiveUpdate -> Form
optsToForm PaginateOptions LiveUpdate
_ = Form
forall a. Monoid a => a
mempty

    getFullname :: LiveUpdate -> PaginateThing LiveUpdate
getFullname LiveUpdate { LiveUpdateID
liveUpdateID :: LiveUpdateID
$sel:liveUpdateID:LiveUpdate :: LiveUpdate -> LiveUpdateID
liveUpdateID } = PaginateThing LiveUpdate
LiveUpdateID
liveUpdateID

-- | ID for a 'LiveUpdate'
newtype LiveUpdateID = LiveUpdateID Text
    deriving stock ( Int -> LiveUpdateID -> ShowS
[LiveUpdateID] -> ShowS
LiveUpdateID -> String
(Int -> LiveUpdateID -> ShowS)
-> (LiveUpdateID -> String)
-> ([LiveUpdateID] -> ShowS)
-> Show LiveUpdateID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveUpdateID] -> ShowS
$cshowList :: [LiveUpdateID] -> ShowS
show :: LiveUpdateID -> String
$cshow :: LiveUpdateID -> String
showsPrec :: Int -> LiveUpdateID -> ShowS
$cshowsPrec :: Int -> LiveUpdateID -> ShowS
Show, (forall x. LiveUpdateID -> Rep LiveUpdateID x)
-> (forall x. Rep LiveUpdateID x -> LiveUpdateID)
-> Generic LiveUpdateID
forall x. Rep LiveUpdateID x -> LiveUpdateID
forall x. LiveUpdateID -> Rep LiveUpdateID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveUpdateID x -> LiveUpdateID
$cfrom :: forall x. LiveUpdateID -> Rep LiveUpdateID x
Generic )
    deriving newtype ( LiveUpdateID -> LiveUpdateID -> Bool
(LiveUpdateID -> LiveUpdateID -> Bool)
-> (LiveUpdateID -> LiveUpdateID -> Bool) -> Eq LiveUpdateID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveUpdateID -> LiveUpdateID -> Bool
$c/= :: LiveUpdateID -> LiveUpdateID -> Bool
== :: LiveUpdateID -> LiveUpdateID -> Bool
$c== :: LiveUpdateID -> LiveUpdateID -> Bool
Eq, LiveUpdateID -> ByteString
LiveUpdateID -> Builder
LiveUpdateID -> Title
(LiveUpdateID -> Title)
-> (LiveUpdateID -> Builder)
-> (LiveUpdateID -> ByteString)
-> (LiveUpdateID -> Title)
-> ToHttpApiData LiveUpdateID
forall a.
(a -> Title)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Title)
-> ToHttpApiData a
toQueryParam :: LiveUpdateID -> Title
$ctoQueryParam :: LiveUpdateID -> Title
toHeader :: LiveUpdateID -> ByteString
$ctoHeader :: LiveUpdateID -> ByteString
toEncodedUrlPiece :: LiveUpdateID -> Builder
$ctoEncodedUrlPiece :: LiveUpdateID -> Builder
toUrlPiece :: LiveUpdateID -> Title
$ctoUrlPiece :: LiveUpdateID -> Title
ToHttpApiData )

instance Thing LiveUpdateID where
    fullname :: LiveUpdateID -> Title
fullname (LiveUpdateID Title
lid) = RedditKind -> Title -> Title
prependType RedditKind
LiveUpdateKind Title
lid

instance FromJSON LiveUpdateID where
    parseJSON :: Value -> Parser LiveUpdateID
parseJSON =
        String
-> (Title -> Parser LiveUpdateID) -> Value -> Parser LiveUpdateID
forall a. String -> (Title -> Parser a) -> Value -> Parser a
withText String
"LiveUpdateID" ((Title -> Parser LiveUpdateID) -> Value -> Parser LiveUpdateID)
-> (Title -> Parser LiveUpdateID) -> Value -> Parser LiveUpdateID
forall a b. (a -> b) -> a -> b
$ Parser Title -> Parser LiveUpdateID
coerce (Parser Title -> Parser LiveUpdateID)
-> (Title -> Parser Title) -> Title -> Parser LiveUpdateID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedditKind -> Title -> Parser Title
dropTypePrefix RedditKind
LiveUpdateKind

-- | External resources embedded in a 'LiveUpdate'
data LiveUpdateEmbed = LiveUpdateEmbed
    { -- | URL pointing to a Reddit-external resource
      LiveUpdateEmbed -> Title
url    :: URL
    , LiveUpdateEmbed -> Maybe Integer
height :: Maybe Integer
    , LiveUpdateEmbed -> Maybe Integer
width  :: Maybe Integer
    }
    deriving stock ( Int -> LiveUpdateEmbed -> ShowS
[LiveUpdateEmbed] -> ShowS
LiveUpdateEmbed -> String
(Int -> LiveUpdateEmbed -> ShowS)
-> (LiveUpdateEmbed -> String)
-> ([LiveUpdateEmbed] -> ShowS)
-> Show LiveUpdateEmbed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveUpdateEmbed] -> ShowS
$cshowList :: [LiveUpdateEmbed] -> ShowS
show :: LiveUpdateEmbed -> String
$cshow :: LiveUpdateEmbed -> String
showsPrec :: Int -> LiveUpdateEmbed -> ShowS
$cshowsPrec :: Int -> LiveUpdateEmbed -> ShowS
Show, LiveUpdateEmbed -> LiveUpdateEmbed -> Bool
(LiveUpdateEmbed -> LiveUpdateEmbed -> Bool)
-> (LiveUpdateEmbed -> LiveUpdateEmbed -> Bool)
-> Eq LiveUpdateEmbed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveUpdateEmbed -> LiveUpdateEmbed -> Bool
$c/= :: LiveUpdateEmbed -> LiveUpdateEmbed -> Bool
== :: LiveUpdateEmbed -> LiveUpdateEmbed -> Bool
$c== :: LiveUpdateEmbed -> LiveUpdateEmbed -> Bool
Eq, (forall x. LiveUpdateEmbed -> Rep LiveUpdateEmbed x)
-> (forall x. Rep LiveUpdateEmbed x -> LiveUpdateEmbed)
-> Generic LiveUpdateEmbed
forall x. Rep LiveUpdateEmbed x -> LiveUpdateEmbed
forall x. LiveUpdateEmbed -> Rep LiveUpdateEmbed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveUpdateEmbed x -> LiveUpdateEmbed
$cfrom :: forall x. LiveUpdateEmbed -> Rep LiveUpdateEmbed x
Generic )

instance FromJSON LiveUpdateEmbed

-- | A user contributor in a 'LiveThread'
data LiveContributor = LiveContributor
    { LiveContributor -> UserID
userID      :: UserID
    , LiveContributor -> Username
username    :: Username
    , LiveContributor -> [LivePermission]
permissions :: [LivePermission]
    }
    deriving stock ( Int -> LiveContributor -> ShowS
[LiveContributor] -> ShowS
LiveContributor -> String
(Int -> LiveContributor -> ShowS)
-> (LiveContributor -> String)
-> ([LiveContributor] -> ShowS)
-> Show LiveContributor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveContributor] -> ShowS
$cshowList :: [LiveContributor] -> ShowS
show :: LiveContributor -> String
$cshow :: LiveContributor -> String
showsPrec :: Int -> LiveContributor -> ShowS
$cshowsPrec :: Int -> LiveContributor -> ShowS
Show, LiveContributor -> LiveContributor -> Bool
(LiveContributor -> LiveContributor -> Bool)
-> (LiveContributor -> LiveContributor -> Bool)
-> Eq LiveContributor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveContributor -> LiveContributor -> Bool
$c/= :: LiveContributor -> LiveContributor -> Bool
== :: LiveContributor -> LiveContributor -> Bool
$c== :: LiveContributor -> LiveContributor -> Bool
Eq, (forall x. LiveContributor -> Rep LiveContributor x)
-> (forall x. Rep LiveContributor x -> LiveContributor)
-> Generic LiveContributor
forall x. Rep LiveContributor x -> LiveContributor
forall x. LiveContributor -> Rep LiveContributor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveContributor x -> LiveContributor
$cfrom :: forall x. LiveContributor -> Rep LiveContributor x
Generic )

instance FromJSON LiveContributor where
    parseJSON :: Value -> Parser LiveContributor
parseJSON = String
-> (Object -> Parser LiveContributor)
-> Value
-> Parser LiveContributor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LiveContributor" ((Object -> Parser LiveContributor)
 -> Value -> Parser LiveContributor)
-> (Object -> Parser LiveContributor)
-> Value
-> Parser LiveContributor
forall a b. (a -> b) -> a -> b
$ \Object
o -> UserID -> Username -> [LivePermission] -> LiveContributor
LiveContributor
        (UserID -> Username -> [LivePermission] -> LiveContributor)
-> Parser UserID
-> Parser (Username -> [LivePermission] -> LiveContributor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Title -> Parser UserID
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"id"
        Parser (Username -> [LivePermission] -> LiveContributor)
-> Parser Username -> Parser ([LivePermission] -> LiveContributor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser Username
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"name"
        Parser ([LivePermission] -> LiveContributor)
-> Parser [LivePermission] -> Parser LiveContributor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser [LivePermission]
permissionsP (Value -> Parser [LivePermission])
-> Parser Value -> Parser [LivePermission]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Title -> Parser Value
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"permissions")
      where
        permissionsP :: Value -> Parser [LivePermission]
permissionsP = String
-> (Array -> Parser [LivePermission])
-> Value
-> Parser [LivePermission]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[LivePermission]" ((Array -> Parser [LivePermission])
 -> Value -> Parser [LivePermission])
-> (Array -> Parser [LivePermission])
-> Value
-> Parser [LivePermission]
forall a b. (a -> b) -> a -> b
$ \Array
a -> case Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
a of
            [ Item Array
"all" ] -> [LivePermission] -> Parser [LivePermission]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LivePermission] -> Parser [LivePermission])
-> [LivePermission] -> Parser [LivePermission]
forall a b. (a -> b) -> a -> b
$ [Item [LivePermission]] -> [LivePermission]
forall l. IsList l => [Item l] -> l
fromList [ Item [LivePermission]
LivePermission
Edit .. Item [LivePermission]
LivePermission
Manage ]
            [Item Array]
xs        -> (Value -> Parser LivePermission)
-> [Value] -> Parser [LivePermission]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser LivePermission
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
[Item Array]
xs

-- | Wrapper to parse lists of 'LiveContributor's
newtype LiveContributorList = LiveContributorList (Seq LiveContributor)
    deriving stock ( Int -> LiveContributorList -> ShowS
[LiveContributorList] -> ShowS
LiveContributorList -> String
(Int -> LiveContributorList -> ShowS)
-> (LiveContributorList -> String)
-> ([LiveContributorList] -> ShowS)
-> Show LiveContributorList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveContributorList] -> ShowS
$cshowList :: [LiveContributorList] -> ShowS
show :: LiveContributorList -> String
$cshow :: LiveContributorList -> String
showsPrec :: Int -> LiveContributorList -> ShowS
$cshowsPrec :: Int -> LiveContributorList -> ShowS
Show, (forall x. LiveContributorList -> Rep LiveContributorList x)
-> (forall x. Rep LiveContributorList x -> LiveContributorList)
-> Generic LiveContributorList
forall x. Rep LiveContributorList x -> LiveContributorList
forall x. LiveContributorList -> Rep LiveContributorList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveContributorList x -> LiveContributorList
$cfrom :: forall x. LiveContributorList -> Rep LiveContributorList x
Generic )

instance FromJSON LiveContributorList where
    -- Depending on the number of contributors, the actual type of the returned
    -- JSON changes
    parseJSON :: Value -> Parser LiveContributorList
parseJSON Value
v = [Parser LiveContributorList] -> Parser LiveContributorList
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Value -> Parser LiveContributorList
contribArray Value
v, Value -> Parser LiveContributorList
contribObject Value
v ]
      where
        contribArray :: Value -> Parser LiveContributorList
contribArray  =
            String
-> (Array -> Parser LiveContributorList)
-> Value
-> Parser LiveContributorList
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[LiveContributorList]" ((Array -> Parser LiveContributorList)
 -> Value -> Parser LiveContributorList)
-> (Array -> Parser LiveContributorList)
-> Value
-> Parser LiveContributorList
forall a b. (a -> b) -> a -> b
$ \Array
a -> case Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
a of
                o :: Item Array
o@(Object _) : [Item Array]
_ -> Value -> Parser LiveContributorList
contribObject Value
Item Array
o
                [Item Array]
_                -> Parser LiveContributorList
forall a. Monoid a => a
mempty

        contribObject :: Value -> Parser LiveContributorList
contribObject = RedditKind
-> String
-> (Object -> Parser LiveContributorList)
-> Value
-> Parser LiveContributorList
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
UserListKind String
"LiveContributorList"
            ((Object -> Parser LiveContributorList)
 -> Value -> Parser LiveContributorList)
-> (Object -> Parser LiveContributorList)
-> Value
-> Parser LiveContributorList
forall a b. (a -> b) -> a -> b
$ ([LiveContributor] -> LiveContributorList)
-> Parser [LiveContributor] -> Parser LiveContributorList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq LiveContributor -> LiveContributorList
LiveContributorList (Seq LiveContributor -> LiveContributorList)
-> ([LiveContributor] -> Seq LiveContributor)
-> [LiveContributor]
-> LiveContributorList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LiveContributor] -> Seq LiveContributor
forall l. IsList l => [Item l] -> l
fromList)
            (Parser [LiveContributor] -> Parser LiveContributorList)
-> (Object -> Parser [LiveContributor])
-> Object
-> Parser LiveContributorList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser [LiveContributor]
contribListP (Value -> Parser [LiveContributor])
-> (Object -> Parser Value) -> Object -> Parser [LiveContributor]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Object -> Title -> Parser Value
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"children"))

        contribListP :: Value -> Parser [LiveContributor]
contribListP  =
            String
-> (Array -> Parser [LiveContributor])
-> Value
-> Parser [LiveContributor]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[LiveContributor]" ((Value -> Parser LiveContributor)
-> [Value] -> Parser [LiveContributor]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser LiveContributor
forall a. FromJSON a => Value -> Parser a
parseJSON ([Value] -> Parser [LiveContributor])
-> (Array -> [Value]) -> Array -> Parser [LiveContributor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall l. IsList l => l -> [Item l]
toList)

-- | Permission granted to a 'LiveContributor'
data LivePermission
    = Edit
    | Update
    | Manage
    | Settings
    deriving stock ( Int -> LivePermission -> ShowS
[LivePermission] -> ShowS
LivePermission -> String
(Int -> LivePermission -> ShowS)
-> (LivePermission -> String)
-> ([LivePermission] -> ShowS)
-> Show LivePermission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LivePermission] -> ShowS
$cshowList :: [LivePermission] -> ShowS
show :: LivePermission -> String
$cshow :: LivePermission -> String
showsPrec :: Int -> LivePermission -> ShowS
$cshowsPrec :: Int -> LivePermission -> ShowS
Show, LivePermission -> LivePermission -> Bool
(LivePermission -> LivePermission -> Bool)
-> (LivePermission -> LivePermission -> Bool) -> Eq LivePermission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LivePermission -> LivePermission -> Bool
$c/= :: LivePermission -> LivePermission -> Bool
== :: LivePermission -> LivePermission -> Bool
$c== :: LivePermission -> LivePermission -> Bool
Eq, (forall x. LivePermission -> Rep LivePermission x)
-> (forall x. Rep LivePermission x -> LivePermission)
-> Generic LivePermission
forall x. Rep LivePermission x -> LivePermission
forall x. LivePermission -> Rep LivePermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LivePermission x -> LivePermission
$cfrom :: forall x. LivePermission -> Rep LivePermission x
Generic, Eq LivePermission
Eq LivePermission
-> (LivePermission -> LivePermission -> Ordering)
-> (LivePermission -> LivePermission -> Bool)
-> (LivePermission -> LivePermission -> Bool)
-> (LivePermission -> LivePermission -> Bool)
-> (LivePermission -> LivePermission -> Bool)
-> (LivePermission -> LivePermission -> LivePermission)
-> (LivePermission -> LivePermission -> LivePermission)
-> Ord LivePermission
LivePermission -> LivePermission -> Bool
LivePermission -> LivePermission -> Ordering
LivePermission -> LivePermission -> LivePermission
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 :: LivePermission -> LivePermission -> LivePermission
$cmin :: LivePermission -> LivePermission -> LivePermission
max :: LivePermission -> LivePermission -> LivePermission
$cmax :: LivePermission -> LivePermission -> LivePermission
>= :: LivePermission -> LivePermission -> Bool
$c>= :: LivePermission -> LivePermission -> Bool
> :: LivePermission -> LivePermission -> Bool
$c> :: LivePermission -> LivePermission -> Bool
<= :: LivePermission -> LivePermission -> Bool
$c<= :: LivePermission -> LivePermission -> Bool
< :: LivePermission -> LivePermission -> Bool
$c< :: LivePermission -> LivePermission -> Bool
compare :: LivePermission -> LivePermission -> Ordering
$ccompare :: LivePermission -> LivePermission -> Ordering
$cp1Ord :: Eq LivePermission
Ord, Int -> LivePermission
LivePermission -> Int
LivePermission -> [LivePermission]
LivePermission -> LivePermission
LivePermission -> LivePermission -> [LivePermission]
LivePermission
-> LivePermission -> LivePermission -> [LivePermission]
(LivePermission -> LivePermission)
-> (LivePermission -> LivePermission)
-> (Int -> LivePermission)
-> (LivePermission -> Int)
-> (LivePermission -> [LivePermission])
-> (LivePermission -> LivePermission -> [LivePermission])
-> (LivePermission -> LivePermission -> [LivePermission])
-> (LivePermission
    -> LivePermission -> LivePermission -> [LivePermission])
-> Enum LivePermission
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LivePermission
-> LivePermission -> LivePermission -> [LivePermission]
$cenumFromThenTo :: LivePermission
-> LivePermission -> LivePermission -> [LivePermission]
enumFromTo :: LivePermission -> LivePermission -> [LivePermission]
$cenumFromTo :: LivePermission -> LivePermission -> [LivePermission]
enumFromThen :: LivePermission -> LivePermission -> [LivePermission]
$cenumFromThen :: LivePermission -> LivePermission -> [LivePermission]
enumFrom :: LivePermission -> [LivePermission]
$cenumFrom :: LivePermission -> [LivePermission]
fromEnum :: LivePermission -> Int
$cfromEnum :: LivePermission -> Int
toEnum :: Int -> LivePermission
$ctoEnum :: Int -> LivePermission
pred :: LivePermission -> LivePermission
$cpred :: LivePermission -> LivePermission
succ :: LivePermission -> LivePermission
$csucc :: LivePermission -> LivePermission
Enum, LivePermission
LivePermission -> LivePermission -> Bounded LivePermission
forall a. a -> a -> Bounded a
maxBound :: LivePermission
$cmaxBound :: LivePermission
minBound :: LivePermission
$cminBound :: LivePermission
Bounded )

instance FromJSON LivePermission where
    parseJSON :: Value -> Parser LivePermission
parseJSON = Options -> Value -> Parser LivePermission
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON --
        Options
defaultOptions { constructorTagModifier :: ShowS
constructorTagModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower }

instance ToHttpApiData LivePermission where
    toQueryParam :: LivePermission -> Title
toQueryParam = LivePermission -> Title
forall a. Show a => a -> Title
showTextData

-- | The reason for reporting the 'LiveThread' to the Reddit admins
data LiveReportType
    = Spam
    | VoteManipulation
    | PersonalInfo
    | Sexualizing
    | SiteBreaking
    deriving stock ( Int -> LiveReportType -> ShowS
[LiveReportType] -> ShowS
LiveReportType -> String
(Int -> LiveReportType -> ShowS)
-> (LiveReportType -> String)
-> ([LiveReportType] -> ShowS)
-> Show LiveReportType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveReportType] -> ShowS
$cshowList :: [LiveReportType] -> ShowS
show :: LiveReportType -> String
$cshow :: LiveReportType -> String
showsPrec :: Int -> LiveReportType -> ShowS
$cshowsPrec :: Int -> LiveReportType -> ShowS
Show, LiveReportType -> LiveReportType -> Bool
(LiveReportType -> LiveReportType -> Bool)
-> (LiveReportType -> LiveReportType -> Bool) -> Eq LiveReportType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveReportType -> LiveReportType -> Bool
$c/= :: LiveReportType -> LiveReportType -> Bool
== :: LiveReportType -> LiveReportType -> Bool
$c== :: LiveReportType -> LiveReportType -> Bool
Eq, (forall x. LiveReportType -> Rep LiveReportType x)
-> (forall x. Rep LiveReportType x -> LiveReportType)
-> Generic LiveReportType
forall x. Rep LiveReportType x -> LiveReportType
forall x. LiveReportType -> Rep LiveReportType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveReportType x -> LiveReportType
$cfrom :: forall x. LiveReportType -> Rep LiveReportType x
Generic )

instance ToHttpApiData LiveReportType where
    toQueryParam :: LiveReportType -> Title
toQueryParam = \case
        LiveReportType
Spam             -> Title
"spam"
        LiveReportType
VoteManipulation -> Title
"vote-manipulation"
        LiveReportType
PersonalInfo     -> Title
"personal-info"
        LiveReportType
Sexualizing      -> Title
"sexualizing-minors"
        LiveReportType
SiteBreaking     -> Title
"site-breaking"