Multireddit.hs

{-# 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 ]