{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} -- | -- Module : Network.Reddit.Multireddit -- Copyright : (c) 2021 Rory Tyler Hayford -- License : BSD-3-Clause -- Maintainer : rory.hayford@protonmail.com -- Stability : experimental -- Portability : GHC -- -- Actions for 'Multireddit's composed of several 'Subreddit's -- module Network.Reddit.Multireddit ( -- * Actions getMultireddit , addToMultireddit , removeFromMultireddit , deleteMultireddit , copyMultireddit , createMultireddit , updateMultireddit -- ** Filters -- | These filters only work on the special subreddits \"all\" and -- \"mod\". When a filter subreddit is added, it will no longer appear -- in @Listing@s for the special subreddit. All of the actions will -- throw 'ErrorWithStatus' exceptions if a non-special subreddit is -- provided as the first argument. Filters are provided as types of -- 'Multireddit's , listFilters , addFilter , removeFilter , clearFilters -- * Types , module M ) where import Data.Aeson ( KeyValue((.=)) ) import Data.Foldable ( traverse_ ) import Network.Reddit.Internal import Network.Reddit.Types import Network.Reddit.Types.Account import Network.Reddit.Types.Multireddit import Network.Reddit.Types.Multireddit as M ( MultiName , MultiPath(MultiPath) , MultiUpdate , MultiVisibility(..) , Multireddit(Multireddit) , NewMulti , NewMultiF(NewMultiF) , defaultMultiUpdate , mkMultiName , multiUpdate ) import Network.Reddit.Types.Subreddit import Network.Reddit.Utils import Web.HttpApiData ( ToHttpApiData(..) ) -- | Get a 'Multireddit' by its path getMultireddit :: MonadReddit m => MultiPath -> m Multireddit getMultireddit mpath = runAction defaultAPIAction { pathSegments = [ "api", "multi", toUrlPiece mpath ] } -- | Add the given subreddit to the existing multireddit addToMultireddit :: MonadReddit m => MultiPath -> SubredditName -> m () addToMultireddit mpath sname = runAction_ defaultAPIAction { pathSegments = [ "api" , "multi" , toUrlPiece mpath , "r" , toUrlPiece sname ] , method = PUT , requestData = mkTextFormData [ ( "model" , textObject [ "name" .= sname ] ) ] } -- | Remove a single subreddit from the existing multireddit removeFromMultireddit :: MonadReddit m => MultiPath -> SubredditName -> m () removeFromMultireddit mpath sname = runAction_ defaultAPIAction { pathSegments = [ "api" , "multi" , toUrlPiece mpath , "r" , toUrlPiece sname ] , method = DELETE } -- | Delete an existing multireddit deleteMultireddit :: MonadReddit m => MultiPath -> m () deleteMultireddit mpath = runAction_ defaultAPIAction { pathSegments = [ "api", "multi", toUrlPiece mpath ] , method = DELETE } -- | Copy an existing 'Multireddit', returning the new one copyMultireddit :: MonadReddit m => MultiPath -> MultiName -> m Multireddit copyMultireddit mpath mname = do -- For some reason, Reddit does not automatically generate the correct path -- for the destination multireddit, but instead requires sending the path in -- the request body. This requires manually fetching the username of the -- authenticated user, to construct the correct destination multipath Account { username } <- getMe runAction defaultAPIAction { pathSegments = [ "api", "multi", "copy" ] , method = POST , requestData = mkTextFormData [ ( "to" , toQueryParam $ MultiPath username mname ) , ("from", toQueryParam mpath) , ("display_name", toQueryParam mname) ] } -- | Create a new 'Multireddit'. Will throw a 409 'ErrorWithStatus' if the -- proposed multireddit already exists. The new multireddit will be created at -- the provided 'MultiPath' parameter createMultireddit :: MonadReddit m => NewMulti -> MultiPath -> m Multireddit createMultireddit newm mpath = runAction defaultAPIAction { pathSegments = [ "api", "multi", toUrlPiece mpath ] , method = POST , requestData = mkTextFormData [ ("model", textEncode newm) ] } -- | Update an existings multireddit, returning the same 'Multireddit' with the -- updates applied updateMultireddit :: MonadReddit m => MultiUpdate -> MultiPath -> m Multireddit updateMultireddit mupd mpath = runAction defaultAPIAction { pathSegments = [ "api", "multi", toUrlPiece mpath ] , method = PUT , requestData = mkTextFormData [ ("model", textEncode mupd) ] } -- | List all of the filters configured for the special subreddit. If no filters -- have been applied, this will throw an 'ErrorWithStatus' exception listFilters :: MonadReddit m => SubredditName -> m Multireddit listFilters special = do Account { username } <- getMe runAction defaultAPIAction { pathSegments = filterPath username special } -- | Add a subreddit to filter from the special subreddit addFilter :: MonadReddit m => SubredditName -- ^ The special sub -> SubredditName -- ^ The sub to filter -> m () addFilter special sname = do Account { username } <- getMe runAction_ defaultAPIAction { pathSegments = filterPath username special <> [ "r", toUrlPiece sname ] , method = PUT , requestData = mkTextFormData [ ( "model" , textObject [ "name" .= sname ] ) ] } -- | Remove a filtered subreddit from the special subreddit. This action will -- succeed even if the filtered subreddit is not in the special subreddit filter removeFilter :: MonadReddit m => SubredditName -- ^ The special sub -> SubredditName -- ^ The sub to remove from the filter -> m () removeFilter special sname = do Account { username } <- getMe runAction_ defaultAPIAction { pathSegments = filterPath username special <> [ "r", toUrlPiece sname ] , method = DELETE } -- | Remove all of the filters for the special subreddit clearFilters :: MonadReddit m => SubredditName -> m () clearFilters special = do Multireddit { subreddits } <- listFilters special traverse_ (removeFilter special) subreddits filterPath :: Username -> SubredditName -> [PathSegment] filterPath uname sname = [ "api", "filter", "user", toUrlPiece uname, "f", toUrlPiece sname ]