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

-- |
-- Module      : Network.Reddit.Types.Multireddit
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Multireddit
    ( Multireddit(..)
    , MultiName
    , mkMultiName
    , MultiVisibility(..)
    , MultiPath(..)
    , NewMultiF(..)
    , NewMulti
    , MultiUpdate
    , multiUpdate
    , defaultMultiUpdate
    ) where

import           Control.Monad.Catch            ( MonadThrow )

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(..)
                 , KeyValue((.=))
                 , ToJSON(..)
                 , Value(String)
                 , object
                 , withArray
                 , withObject
                 , withText
                 )
import           Data.Functor.Identity          ( Identity )
import           Data.Maybe                     ( catMaybes )
import           Data.Sequence                  ( Seq )
import           Data.Text                      ( Text )
import qualified Data.Text                      as T
import           Data.Time                      ( UTCTime )
import           Data.Traversable               ( for )

import           GHC.Exts                       ( IsList(fromList, toList) )
import           GHC.Generics                   ( Generic )

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

import           Web.HttpApiData                ( ToHttpApiData(..) )

-- | An aggregation of individual 'Subreddit's
data Multireddit = Multireddit
    { Multireddit -> MultiName
name            :: MultiName
    , Multireddit -> Text
displayName     :: Text
    , Multireddit -> Seq SubredditName
subreddits      :: Seq SubredditName
    , Multireddit -> UTCTime
created         :: UTCTime
    , Multireddit -> Text
description     :: Body
    , Multireddit -> Text
descriptionHTML :: Body
    , Multireddit -> Maybe Text
keyColor        :: Maybe RGBText
    , Multireddit -> MultiPath
multipath       :: MultiPath
    , Multireddit -> MultiVisibility
visibility      :: MultiVisibility
      -- | The path to the original multireddit from which
      -- this one was copied, if any, e.g.:
      -- @\/u\/<USERNAME>\/m\/<MULTINAME>@
    , Multireddit -> Maybe MultiPath
copiedFrom      :: Maybe MultiPath
      -- | Whether the authenticated user can edit this
      -- multireddit
    , Multireddit -> Bool
canEdit         :: Bool
    , Multireddit -> Maybe Bool
over18          :: Maybe Bool
    }
    deriving stock ( Int -> Multireddit -> ShowS
[Multireddit] -> ShowS
Multireddit -> String
(Int -> Multireddit -> ShowS)
-> (Multireddit -> String)
-> ([Multireddit] -> ShowS)
-> Show Multireddit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Multireddit] -> ShowS
$cshowList :: [Multireddit] -> ShowS
show :: Multireddit -> String
$cshow :: Multireddit -> String
showsPrec :: Int -> Multireddit -> ShowS
$cshowsPrec :: Int -> Multireddit -> ShowS
Show, Multireddit -> Multireddit -> Bool
(Multireddit -> Multireddit -> Bool)
-> (Multireddit -> Multireddit -> Bool) -> Eq Multireddit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Multireddit -> Multireddit -> Bool
$c/= :: Multireddit -> Multireddit -> Bool
== :: Multireddit -> Multireddit -> Bool
$c== :: Multireddit -> Multireddit -> Bool
Eq, (forall x. Multireddit -> Rep Multireddit x)
-> (forall x. Rep Multireddit x -> Multireddit)
-> Generic Multireddit
forall x. Rep Multireddit x -> Multireddit
forall x. Multireddit -> Rep Multireddit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Multireddit x -> Multireddit
$cfrom :: forall x. Multireddit -> Rep Multireddit x
Generic )

instance FromJSON Multireddit where
    parseJSON :: Value -> Parser Multireddit
parseJSON = RedditKind
-> String
-> (Object -> Parser Multireddit)
-> Value
-> Parser Multireddit
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
LabeledMultiKind String
"Multireddit" ((Object -> Parser Multireddit) -> Value -> Parser Multireddit)
-> (Object -> Parser Multireddit) -> Value -> Parser Multireddit
forall a b. (a -> b) -> a -> b
$ \Object
o -> MultiName
-> Text
-> Seq SubredditName
-> UTCTime
-> Text
-> Text
-> Maybe Text
-> MultiPath
-> MultiVisibility
-> Maybe MultiPath
-> Bool
-> Maybe Bool
-> Multireddit
Multireddit
        (MultiName
 -> Text
 -> Seq SubredditName
 -> UTCTime
 -> Text
 -> Text
 -> Maybe Text
 -> MultiPath
 -> MultiVisibility
 -> Maybe MultiPath
 -> Bool
 -> Maybe Bool
 -> Multireddit)
-> Parser MultiName
-> Parser
     (Text
      -> Seq SubredditName
      -> UTCTime
      -> Text
      -> Text
      -> Maybe Text
      -> MultiPath
      -> MultiVisibility
      -> Maybe MultiPath
      -> Bool
      -> Maybe Bool
      -> Multireddit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser MultiName
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
        Parser
  (Text
   -> Seq SubredditName
   -> UTCTime
   -> Text
   -> Text
   -> Maybe Text
   -> MultiPath
   -> MultiVisibility
   -> Maybe MultiPath
   -> Bool
   -> Maybe Bool
   -> Multireddit)
-> Parser Text
-> Parser
     (Seq SubredditName
      -> UTCTime
      -> Text
      -> Text
      -> Maybe Text
      -> MultiPath
      -> MultiVisibility
      -> Maybe MultiPath
      -> Bool
      -> Maybe Bool
      -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"display_name"
        Parser
  (Seq SubredditName
   -> UTCTime
   -> Text
   -> Text
   -> Maybe Text
   -> MultiPath
   -> MultiVisibility
   -> Maybe MultiPath
   -> Bool
   -> Maybe Bool
   -> Multireddit)
-> Parser (Seq SubredditName)
-> Parser
     (UTCTime
      -> Text
      -> Text
      -> Maybe Text
      -> MultiPath
      -> MultiVisibility
      -> Maybe MultiPath
      -> Bool
      -> Maybe Bool
      -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([SubredditName] -> Seq SubredditName
forall l. IsList l => [Item l] -> l
fromList ([SubredditName] -> Seq SubredditName)
-> Parser [SubredditName] -> Parser (Seq SubredditName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser [SubredditName]
subredditsP (Value -> Parser [SubredditName])
-> Parser Value -> Parser [SubredditName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"subreddits"))
        Parser
  (UTCTime
   -> Text
   -> Text
   -> Maybe Text
   -> MultiPath
   -> MultiVisibility
   -> Maybe MultiPath
   -> Bool
   -> Maybe Bool
   -> Multireddit)
-> Parser UTCTime
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> MultiPath
      -> MultiVisibility
      -> Maybe MultiPath
      -> Bool
      -> Maybe Bool
      -> Multireddit)
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 -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_utc")
        Parser
  (Text
   -> Text
   -> Maybe Text
   -> MultiPath
   -> MultiVisibility
   -> Maybe MultiPath
   -> Bool
   -> Maybe Bool
   -> Multireddit)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> MultiPath
      -> MultiVisibility
      -> Maybe MultiPath
      -> Bool
      -> Maybe Bool
      -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"description_md"
        Parser
  (Text
   -> Maybe Text
   -> MultiPath
   -> MultiVisibility
   -> Maybe MultiPath
   -> Bool
   -> Maybe Bool
   -> Multireddit)
-> Parser Text
-> Parser
     (Maybe Text
      -> MultiPath
      -> MultiVisibility
      -> Maybe MultiPath
      -> Bool
      -> Maybe Bool
      -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"description_html"
        Parser
  (Maybe Text
   -> MultiPath
   -> MultiVisibility
   -> Maybe MultiPath
   -> Bool
   -> Maybe Bool
   -> Multireddit)
-> Parser (Maybe Text)
-> Parser
     (MultiPath
      -> MultiVisibility
      -> Maybe MultiPath
      -> Bool
      -> Maybe Bool
      -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"key_color"
        Parser
  (MultiPath
   -> MultiVisibility
   -> Maybe MultiPath
   -> Bool
   -> Maybe Bool
   -> Multireddit)
-> Parser MultiPath
-> Parser
     (MultiVisibility
      -> Maybe MultiPath -> Bool -> Maybe Bool -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser MultiPath
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path"
        Parser
  (MultiVisibility
   -> Maybe MultiPath -> Bool -> Maybe Bool -> Multireddit)
-> Parser MultiVisibility
-> Parser (Maybe MultiPath -> Bool -> Maybe Bool -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser MultiVisibility
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"visibility"
        Parser (Maybe MultiPath -> Bool -> Maybe Bool -> Multireddit)
-> Parser (Maybe MultiPath)
-> Parser (Bool -> Maybe Bool -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe MultiPath)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"copied_from"
        Parser (Bool -> Maybe Bool -> Multireddit)
-> Parser Bool -> Parser (Maybe Bool -> Multireddit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"can_edit"
        Parser (Maybe Bool -> Multireddit)
-> Parser (Maybe Bool) -> Parser Multireddit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"over_18"
      where
        subredditsP :: Value -> Parser [SubredditName]
subredditsP = String
-> (Array -> Parser [SubredditName])
-> Value
-> Parser [SubredditName]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[Object]" Array -> Parser [SubredditName]
forall l b.
(IsList l, FromJSON b, Item l ~ Value) =>
l -> Parser [b]
namesP

        namesP :: l -> Parser [b]
namesP l
as = [Value] -> (Value -> Parser b) -> Parser [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (l -> [Item l]
forall l. IsList l => l -> [Item l]
toList l
as) ((Value -> Parser b) -> Parser [b])
-> ((Object -> Parser b) -> Value -> Parser b)
-> (Object -> Parser b)
-> Parser [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Object -> Parser b) -> Value -> Parser b
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" ((Object -> Parser b) -> Parser [b])
-> (Object -> Parser b) -> Parser [b]
forall a b. (a -> b) -> a -> b
$ \Object
o -> Object
o Object -> Text -> Parser b
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"

-- | The name of a 'Multireddit', which may only contain alphanumeric characters
newtype MultiName = MultiName Text
    deriving stock ( Int -> MultiName -> ShowS
[MultiName] -> ShowS
MultiName -> String
(Int -> MultiName -> ShowS)
-> (MultiName -> String)
-> ([MultiName] -> ShowS)
-> Show MultiName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiName] -> ShowS
$cshowList :: [MultiName] -> ShowS
show :: MultiName -> String
$cshow :: MultiName -> String
showsPrec :: Int -> MultiName -> ShowS
$cshowsPrec :: Int -> MultiName -> ShowS
Show, (forall x. MultiName -> Rep MultiName x)
-> (forall x. Rep MultiName x -> MultiName) -> Generic MultiName
forall x. Rep MultiName x -> MultiName
forall x. MultiName -> Rep MultiName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MultiName x -> MultiName
$cfrom :: forall x. MultiName -> Rep MultiName x
Generic )
    deriving newtype ( Value -> Parser [MultiName]
Value -> Parser MultiName
(Value -> Parser MultiName)
-> (Value -> Parser [MultiName]) -> FromJSON MultiName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MultiName]
$cparseJSONList :: Value -> Parser [MultiName]
parseJSON :: Value -> Parser MultiName
$cparseJSON :: Value -> Parser MultiName
FromJSON, MultiName -> ByteString
MultiName -> Builder
MultiName -> Text
(MultiName -> Text)
-> (MultiName -> Builder)
-> (MultiName -> ByteString)
-> (MultiName -> Text)
-> ToHttpApiData MultiName
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: MultiName -> Text
$ctoQueryParam :: MultiName -> Text
toHeader :: MultiName -> ByteString
$ctoHeader :: MultiName -> ByteString
toEncodedUrlPiece :: MultiName -> Builder
$ctoEncodedUrlPiece :: MultiName -> Builder
toUrlPiece :: MultiName -> Text
$ctoUrlPiece :: MultiName -> Text
ToHttpApiData )
    deriving ( MultiName -> MultiName -> Bool
(MultiName -> MultiName -> Bool)
-> (MultiName -> MultiName -> Bool) -> Eq MultiName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiName -> MultiName -> Bool
$c/= :: MultiName -> MultiName -> Bool
== :: MultiName -> MultiName -> Bool
$c== :: MultiName -> MultiName -> Bool
Eq ) via CIText MultiName

-- | Smart constructor for 'MultiName's, which may only contain alphanumeric
-- characters
mkMultiName :: MonadThrow m => Text -> m MultiName
mkMultiName :: Text -> m MultiName
mkMultiName = Maybe String -> Maybe (Int, Int) -> Text -> Text -> m MultiName
forall (m :: * -> *) a.
(MonadThrow m, Coercible a Text) =>
Maybe String -> Maybe (Int, Int) -> Text -> Text -> m a
validateName Maybe String
forall a. Maybe a
Nothing Maybe (Int, Int)
forall a. Maybe a
Nothing Text
"MultiName"

-- | The path to a 'Multireddit', of the form @\/user\/<USERNAME>\/m\/<MULTINAME>@
data MultiPath = MultiPath { MultiPath -> Username
username :: Username, MultiPath -> MultiName
multiname :: MultiName }
    deriving stock ( Int -> MultiPath -> ShowS
[MultiPath] -> ShowS
MultiPath -> String
(Int -> MultiPath -> ShowS)
-> (MultiPath -> String)
-> ([MultiPath] -> ShowS)
-> Show MultiPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiPath] -> ShowS
$cshowList :: [MultiPath] -> ShowS
show :: MultiPath -> String
$cshow :: MultiPath -> String
showsPrec :: Int -> MultiPath -> ShowS
$cshowsPrec :: Int -> MultiPath -> ShowS
Show, MultiPath -> MultiPath -> Bool
(MultiPath -> MultiPath -> Bool)
-> (MultiPath -> MultiPath -> Bool) -> Eq MultiPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiPath -> MultiPath -> Bool
$c/= :: MultiPath -> MultiPath -> Bool
== :: MultiPath -> MultiPath -> Bool
$c== :: MultiPath -> MultiPath -> Bool
Eq, (forall x. MultiPath -> Rep MultiPath x)
-> (forall x. Rep MultiPath x -> MultiPath) -> Generic MultiPath
forall x. Rep MultiPath x -> MultiPath
forall x. MultiPath -> Rep MultiPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MultiPath x -> MultiPath
$cfrom :: forall x. MultiPath -> Rep MultiPath x
Generic )

instance FromJSON MultiPath where
    parseJSON :: Value -> Parser MultiPath
parseJSON = String -> (Text -> Parser MultiPath) -> Value -> Parser MultiPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"MultiPath" ((Text -> Parser MultiPath) -> Value -> Parser MultiPath)
-> (Text -> Parser MultiPath) -> Value -> Parser MultiPath
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Text -> [Text]
T.splitOn Text
"/" Text
t of
        Text
_ : Text
"user" : Text
uname : Text
path : Text
mname : [Text]
_
            | Text
path Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"m", Text
"f" ] -> Username -> MultiName -> MultiPath
MultiPath
                (Username -> MultiName -> MultiPath)
-> Parser Username -> Parser (MultiName -> MultiPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Username
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
uname)
                Parser (MultiName -> MultiPath)
-> Parser MultiName -> Parser MultiPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MultiName
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
mname)
            | Bool
otherwise -> Parser MultiPath
forall a. Monoid a => a
mempty
        [Text]
_ -> Parser MultiPath
forall a. Monoid a => a
mempty

instance ToHttpApiData MultiPath where
    toUrlPiece :: MultiPath -> Text
toUrlPiece MultiPath { Username
MultiName
multiname :: MultiName
username :: Username
$sel:multiname:MultiPath :: MultiPath -> MultiName
$sel:username:MultiPath :: MultiPath -> Username
.. } =
        Text -> [Text] -> Text
T.intercalate Text
"/"
                      [ Text
"user"
                      , Username -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Username
username
                      , Text
"m"
                      , MultiName -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece MultiName
multiname
                      ]

-- | The configured visibility level for a 'Multireddit'
data MultiVisibility
    = PrivateMulti
    | PublicMulti
    | HiddenMulti
    deriving stock ( Int -> MultiVisibility -> ShowS
[MultiVisibility] -> ShowS
MultiVisibility -> String
(Int -> MultiVisibility -> ShowS)
-> (MultiVisibility -> String)
-> ([MultiVisibility] -> ShowS)
-> Show MultiVisibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiVisibility] -> ShowS
$cshowList :: [MultiVisibility] -> ShowS
show :: MultiVisibility -> String
$cshow :: MultiVisibility -> String
showsPrec :: Int -> MultiVisibility -> ShowS
$cshowsPrec :: Int -> MultiVisibility -> ShowS
Show, MultiVisibility -> MultiVisibility -> Bool
(MultiVisibility -> MultiVisibility -> Bool)
-> (MultiVisibility -> MultiVisibility -> Bool)
-> Eq MultiVisibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiVisibility -> MultiVisibility -> Bool
$c/= :: MultiVisibility -> MultiVisibility -> Bool
== :: MultiVisibility -> MultiVisibility -> Bool
$c== :: MultiVisibility -> MultiVisibility -> Bool
Eq, (forall x. MultiVisibility -> Rep MultiVisibility x)
-> (forall x. Rep MultiVisibility x -> MultiVisibility)
-> Generic MultiVisibility
forall x. Rep MultiVisibility x -> MultiVisibility
forall x. MultiVisibility -> Rep MultiVisibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MultiVisibility x -> MultiVisibility
$cfrom :: forall x. MultiVisibility -> Rep MultiVisibility x
Generic, Eq MultiVisibility
Eq MultiVisibility
-> (MultiVisibility -> MultiVisibility -> Ordering)
-> (MultiVisibility -> MultiVisibility -> Bool)
-> (MultiVisibility -> MultiVisibility -> Bool)
-> (MultiVisibility -> MultiVisibility -> Bool)
-> (MultiVisibility -> MultiVisibility -> Bool)
-> (MultiVisibility -> MultiVisibility -> MultiVisibility)
-> (MultiVisibility -> MultiVisibility -> MultiVisibility)
-> Ord MultiVisibility
MultiVisibility -> MultiVisibility -> Bool
MultiVisibility -> MultiVisibility -> Ordering
MultiVisibility -> MultiVisibility -> MultiVisibility
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 :: MultiVisibility -> MultiVisibility -> MultiVisibility
$cmin :: MultiVisibility -> MultiVisibility -> MultiVisibility
max :: MultiVisibility -> MultiVisibility -> MultiVisibility
$cmax :: MultiVisibility -> MultiVisibility -> MultiVisibility
>= :: MultiVisibility -> MultiVisibility -> Bool
$c>= :: MultiVisibility -> MultiVisibility -> Bool
> :: MultiVisibility -> MultiVisibility -> Bool
$c> :: MultiVisibility -> MultiVisibility -> Bool
<= :: MultiVisibility -> MultiVisibility -> Bool
$c<= :: MultiVisibility -> MultiVisibility -> Bool
< :: MultiVisibility -> MultiVisibility -> Bool
$c< :: MultiVisibility -> MultiVisibility -> Bool
compare :: MultiVisibility -> MultiVisibility -> Ordering
$ccompare :: MultiVisibility -> MultiVisibility -> Ordering
$cp1Ord :: Eq MultiVisibility
Ord )

instance FromJSON MultiVisibility where
    parseJSON :: Value -> Parser MultiVisibility
parseJSON = String
-> (Text -> Parser MultiVisibility)
-> Value
-> Parser MultiVisibility
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"MultiVisibility" ((Text -> Parser MultiVisibility)
 -> Value -> Parser MultiVisibility)
-> (Text -> Parser MultiVisibility)
-> Value
-> Parser MultiVisibility
forall a b. (a -> b) -> a -> b
$ \case
        Text
"private" -> MultiVisibility -> Parser MultiVisibility
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultiVisibility
PrivateMulti
        Text
"public"  -> MultiVisibility -> Parser MultiVisibility
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultiVisibility
PublicMulti
        Text
"hidden"  -> MultiVisibility -> Parser MultiVisibility
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultiVisibility
HiddenMulti
        Text
_         -> Parser MultiVisibility
forall a. Monoid a => a
mempty

instance ToJSON MultiVisibility where
    toJSON :: MultiVisibility -> Value
toJSON = \case
        MultiVisibility
PrivateMulti -> Value
"private"
        MultiVisibility
PublicMulti  -> Value
"public"
        MultiVisibility
HiddenMulti  -> Value
"hidden"

-- | Can represent either a new multireddit when parameterized by 'Identity', or
-- a multireddit update when parameterized by 'Maybe'. In both cases, @keyColor@
-- is an optional field
data NewMultiF f = NewMultiF
    { NewMultiF f -> HKD f Text
description :: HKD f Body
    , NewMultiF f -> HKD f Text
displayName :: HKD f Text
    , NewMultiF f -> HKD f (Seq SubredditName)
subreddits  :: HKD f (Seq SubredditName)
    , NewMultiF f -> HKD f MultiVisibility
visibility  :: HKD f MultiVisibility
    , NewMultiF f -> Maybe Text
keyColor    :: Maybe RGBText
    }
    deriving stock ( (forall x. NewMultiF f -> Rep (NewMultiF f) x)
-> (forall x. Rep (NewMultiF f) x -> NewMultiF f)
-> Generic (NewMultiF f)
forall x. Rep (NewMultiF f) x -> NewMultiF f
forall x. NewMultiF f -> Rep (NewMultiF f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (NewMultiF f) x -> NewMultiF f
forall (f :: * -> *) x. NewMultiF f -> Rep (NewMultiF f) x
$cto :: forall (f :: * -> *) x. Rep (NewMultiF f) x -> NewMultiF f
$cfrom :: forall (f :: * -> *) x. NewMultiF f -> Rep (NewMultiF f) x
Generic )

-- | An new multireddit, where all fields are required
type NewMulti = NewMultiF Identity

deriving stock instance Show NewMulti

instance ToJSON NewMulti where
    toJSON :: NewMulti -> Value
toJSON NewMultiF { Maybe Text
HKD Identity Text
HKD Identity (Seq SubredditName)
HKD Identity MultiVisibility
keyColor :: Maybe Text
visibility :: HKD Identity MultiVisibility
subreddits :: HKD Identity (Seq SubredditName)
displayName :: HKD Identity Text
description :: HKD Identity Text
$sel:keyColor:NewMultiF :: forall (f :: * -> *). NewMultiF f -> Maybe Text
$sel:visibility:NewMultiF :: forall (f :: * -> *). NewMultiF f -> HKD f MultiVisibility
$sel:subreddits:NewMultiF :: forall (f :: * -> *). NewMultiF f -> HKD f (Seq SubredditName)
$sel:displayName:NewMultiF :: forall (f :: * -> *). NewMultiF f -> HKD f Text
$sel:description:NewMultiF :: forall (f :: * -> *). NewMultiF f -> HKD f Text
.. } = [Pair] -> Value
object
        ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Text
"description_md" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
HKD Identity Text
description
          , Text
"display_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
HKD Identity Text
displayName
          , Text
"subreddits" Text -> Seq Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seq SubredditName -> Seq Value
forall (t :: * -> *). Functor t => t SubredditName -> t Value
multiSubsObject Seq SubredditName
HKD Identity (Seq SubredditName)
subreddits
          , Text
"visibility" Text -> MultiVisibility -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= HKD Identity MultiVisibility
MultiVisibility
visibility
          ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair]
forall a. Monoid a => a
mempty (Pair -> [Pair]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> (Text -> Pair) -> Text -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
(.=) Text
"key_color") Maybe Text
keyColor

-- | An update to a multireddit, where all fields are optional. If a field
-- is not provided, it is omitted during JSON encoding
type MultiUpdate = NewMultiF Maybe

deriving stock instance Show MultiUpdate

instance ToJSON MultiUpdate where
    toJSON :: MultiUpdate -> Value
toJSON NewMultiF { Maybe Text
HKD Maybe Text
HKD Maybe (Seq SubredditName)
HKD Maybe MultiVisibility
keyColor :: Maybe Text
visibility :: HKD Maybe MultiVisibility
subreddits :: HKD Maybe (Seq SubredditName)
displayName :: HKD Maybe Text
description :: HKD Maybe Text
$sel:keyColor:NewMultiF :: forall (f :: * -> *). NewMultiF f -> Maybe Text
$sel:visibility:NewMultiF :: forall (f :: * -> *). NewMultiF f -> HKD f MultiVisibility
$sel:subreddits:NewMultiF :: forall (f :: * -> *). NewMultiF f -> HKD f (Seq SubredditName)
$sel:displayName:NewMultiF :: forall (f :: * -> *). NewMultiF f -> HKD f Text
$sel:description:NewMultiF :: forall (f :: * -> *). NewMultiF f -> HKD f Text
.. } = [Pair] -> Value
object
        ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"description_md" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
HKD Maybe Text
description
                    , (Text
"display_name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
HKD Maybe Text
displayName
                    , (Text
"subreddits" Text -> Seq Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Seq Value -> Pair)
-> (Seq SubredditName -> Seq Value) -> Seq SubredditName -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq SubredditName -> Seq Value
forall (t :: * -> *). Functor t => t SubredditName -> t Value
multiSubsObject (Seq SubredditName -> Pair)
-> Maybe (Seq SubredditName) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Seq SubredditName)
HKD Maybe (Seq SubredditName)
subreddits
                    , (Text
"visibility" Text -> MultiVisibility -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (MultiVisibility -> Pair) -> Maybe MultiVisibility -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MultiVisibility
HKD Maybe MultiVisibility
visibility
                    , (Text
"key_color" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
keyColor
                    ]

-- | Convert a 'Multireddit' to a 'MultiUpdate'
multiUpdate :: Multireddit -> MultiUpdate
multiUpdate :: Multireddit -> MultiUpdate
multiUpdate Multireddit { Bool
Maybe Bool
Maybe Text
Maybe MultiPath
Text
UTCTime
Seq SubredditName
MultiVisibility
MultiPath
MultiName
over18 :: Maybe Bool
canEdit :: Bool
copiedFrom :: Maybe MultiPath
visibility :: MultiVisibility
multipath :: MultiPath
keyColor :: Maybe Text
descriptionHTML :: Text
description :: Text
created :: UTCTime
subreddits :: Seq SubredditName
displayName :: Text
name :: MultiName
$sel:over18:Multireddit :: Multireddit -> Maybe Bool
$sel:canEdit:Multireddit :: Multireddit -> Bool
$sel:copiedFrom:Multireddit :: Multireddit -> Maybe MultiPath
$sel:visibility:Multireddit :: Multireddit -> MultiVisibility
$sel:multipath:Multireddit :: Multireddit -> MultiPath
$sel:keyColor:Multireddit :: Multireddit -> Maybe Text
$sel:descriptionHTML:Multireddit :: Multireddit -> Text
$sel:description:Multireddit :: Multireddit -> Text
$sel:created:Multireddit :: Multireddit -> UTCTime
$sel:subreddits:Multireddit :: Multireddit -> Seq SubredditName
$sel:displayName:Multireddit :: Multireddit -> Text
$sel:name:Multireddit :: Multireddit -> MultiName
.. } = NewMultiF :: forall (f :: * -> *).
HKD f Text
-> HKD f Text
-> HKD f (Seq SubredditName)
-> HKD f MultiVisibility
-> Maybe Text
-> NewMultiF f
NewMultiF
    { $sel:description:NewMultiF :: HKD Maybe Text
description = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description
    , $sel:displayName:NewMultiF :: HKD Maybe Text
displayName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
displayName
    , $sel:subreddits:NewMultiF :: HKD Maybe (Seq SubredditName)
subreddits  = Seq SubredditName -> Maybe (Seq SubredditName)
forall a. a -> Maybe a
Just Seq SubredditName
subreddits
    , $sel:visibility:NewMultiF :: HKD Maybe MultiVisibility
visibility  = MultiVisibility -> Maybe MultiVisibility
forall a. a -> Maybe a
Just MultiVisibility
visibility
    , Maybe Text
keyColor :: Maybe Text
$sel:keyColor:NewMultiF :: Maybe Text
keyColor
    }

-- | A 'MultiUpdate' with all @Nothing@ fields, for convenience
defaultMultiUpdate :: MultiUpdate
defaultMultiUpdate :: MultiUpdate
defaultMultiUpdate = NewMultiF :: forall (f :: * -> *).
HKD f Text
-> HKD f Text
-> HKD f (Seq SubredditName)
-> HKD f MultiVisibility
-> Maybe Text
-> NewMultiF f
NewMultiF
    { $sel:description:NewMultiF :: HKD Maybe Text
description = HKD Maybe Text
forall a. Maybe a
Nothing
    , $sel:displayName:NewMultiF :: HKD Maybe Text
displayName = HKD Maybe Text
forall a. Maybe a
Nothing
    , $sel:subreddits:NewMultiF :: HKD Maybe (Seq SubredditName)
subreddits  = HKD Maybe (Seq SubredditName)
forall a. Maybe a
Nothing
    , $sel:visibility:NewMultiF :: HKD Maybe MultiVisibility
visibility  = HKD Maybe MultiVisibility
forall a. Maybe a
Nothing
    , $sel:keyColor:NewMultiF :: Maybe Text
keyColor    = Maybe Text
forall a. Maybe a
Nothing
    }

-- | Endpoints receiving JSON for creating or updating multireddits expect an array
-- of single-member objects, of the form @{\"name\": ...}@, instead of the far
-- more sensical array of names that one would expect
multiSubsObject :: Functor t => t SubredditName -> t Value
multiSubsObject :: t SubredditName -> t Value
multiSubsObject = (SubredditName -> Value) -> t SubredditName -> t Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Pair] -> Value
object ([Pair] -> Value)
-> (SubredditName -> [Pair]) -> SubredditName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> [Pair]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair])
-> (SubredditName -> Pair) -> SubredditName -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"name" Text -> SubredditName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=))