{-# 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
--
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.Me
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 :: MultiPath -> m Multireddit
getMultireddit MultiPath
mpath =
    APIAction Multireddit -> m Multireddit
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"multi", MultiPath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece MultiPath
mpath ] }

-- | Add the given subreddit to the existing multireddit
addToMultireddit :: MonadReddit m => MultiPath -> SubredditName -> m ()
addToMultireddit :: MultiPath -> SubredditName -> m ()
addToMultireddit MultiPath
mpath SubredditName
sname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api"
                                , PathSegment
"multi"
                                , MultiPath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece MultiPath
mpath
                                , PathSegment
"r"
                                , SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname
                                ]
               , $sel:method:APIAction :: Method
method       = Method
PUT
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ ( PathSegment
"model"
                                      , [Pair] -> PathSegment
textObject [ PathSegment
"name" PathSegment -> SubredditName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => PathSegment -> v -> kv
.= SubredditName
sname ]
                                      )
                                    ]
               }

-- | Remove a single subreddit from the existing multireddit
removeFromMultireddit :: MonadReddit m => MultiPath -> SubredditName -> m ()
removeFromMultireddit :: MultiPath -> SubredditName -> m ()
removeFromMultireddit MultiPath
mpath SubredditName
sname =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api"
                                , PathSegment
"multi"
                                , MultiPath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece MultiPath
mpath
                                , PathSegment
"r"
                                , SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname
                                ]
               , $sel:method:APIAction :: Method
method       = Method
DELETE
               }

-- | Delete an existing multireddit
deleteMultireddit :: MonadReddit m => MultiPath -> m ()
deleteMultireddit :: MultiPath -> m ()
deleteMultireddit MultiPath
mpath =
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"multi", MultiPath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece MultiPath
mpath ]
               , $sel:method:APIAction :: Method
method       = Method
DELETE
               }

-- | Copy an existing 'Multireddit', returning the new one
copyMultireddit :: MonadReddit m => MultiPath -> MultiName -> m Multireddit
copyMultireddit :: MultiPath -> MultiName -> m Multireddit
copyMultireddit MultiPath
mpath MultiName
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
$sel:username:Account :: Account -> Username
username :: Username
username } <- m Account
forall (m :: * -> *). MonadReddit m => m Account
getMe
    APIAction Multireddit -> m Multireddit
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"multi", PathSegment
"copy" ]
              , $sel:method:APIAction :: Method
method       = Method
POST
              , $sel:requestData:APIAction :: WithData
requestData  =
                    [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ ( PathSegment
"to"
                                     , MultiPath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam (MultiPath -> PathSegment) -> MultiPath -> PathSegment
forall a b. (a -> b) -> a -> b
$ Username -> MultiName -> MultiPath
MultiPath Username
username MultiName
mname
                                     )
                                   , (PathSegment
"from", MultiPath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam MultiPath
mpath)
                                   , (PathSegment
"display_name", MultiName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toQueryParam MultiName
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 :: NewMulti -> MultiPath -> m Multireddit
createMultireddit NewMulti
newm MultiPath
mpath =
    APIAction Multireddit -> m Multireddit
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"multi", MultiPath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece MultiPath
mpath ]
              , $sel:method:APIAction :: Method
method       = Method
POST
              , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"model", NewMulti -> PathSegment
forall a. ToJSON a => a -> PathSegment
textEncode NewMulti
newm) ]
              }

-- | Update an existings multireddit, returning the same 'Multireddit' with the
-- updates applied
updateMultireddit
    :: MonadReddit m => MultiUpdate -> MultiPath -> m Multireddit
updateMultireddit :: MultiUpdate -> MultiPath -> m Multireddit
updateMultireddit MultiUpdate
mupd MultiPath
mpath =
    APIAction Multireddit -> m Multireddit
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = [ PathSegment
"api", PathSegment
"multi", MultiPath -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece MultiPath
mpath ]
              , $sel:method:APIAction :: Method
method       = Method
PUT
              , $sel:requestData:APIAction :: WithData
requestData  = [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ (PathSegment
"model", MultiUpdate -> PathSegment
forall a. ToJSON a => a -> PathSegment
textEncode MultiUpdate
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 :: SubredditName -> m Multireddit
listFilters SubredditName
special = do
    Account { Username
username :: Username
$sel:username:Account :: Account -> Username
username } <- m Account
forall (m :: * -> *). MonadReddit m => m Account
getMe
    APIAction Multireddit -> m Multireddit
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments = Username -> SubredditName -> [PathSegment]
filterPath Username
username SubredditName
special }

-- | Add a subreddit to filter from the special subreddit
addFilter :: MonadReddit m
          => SubredditName -- ^ The special sub
          -> SubredditName -- ^ The sub to filter
          -> m ()
addFilter :: SubredditName -> SubredditName -> m ()
addFilter SubredditName
special SubredditName
sname = do
    Account { Username
username :: Username
$sel:username:Account :: Account -> Username
username } <- m Account
forall (m :: * -> *). MonadReddit m => m Account
getMe
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                     Username -> SubredditName -> [PathSegment]
filterPath Username
username SubredditName
special [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment
"r", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname ]
               , $sel:method:APIAction :: Method
method       = Method
PUT
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(PathSegment, PathSegment)] -> WithData
mkTextFormData [ ( PathSegment
"model"
                                      , [Pair] -> PathSegment
textObject [ PathSegment
"name" PathSegment -> SubredditName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => PathSegment -> v -> kv
.= SubredditName
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 :: SubredditName -> SubredditName -> m ()
removeFilter SubredditName
special SubredditName
sname = do
    Account { Username
username :: Username
$sel:username:Account :: Account -> Username
username } <- m Account
forall (m :: * -> *). MonadReddit m => m Account
getMe
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [PathSegment]
pathSegments =
                     Username -> SubredditName -> [PathSegment]
filterPath Username
username SubredditName
special [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. Semigroup a => a -> a -> a
<> [ PathSegment
"r", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname ]
               , $sel:method:APIAction :: Method
method       = Method
DELETE
               }

-- | Remove all of the filters for the special subreddit
clearFilters :: MonadReddit m => SubredditName -> m ()
clearFilters :: SubredditName -> m ()
clearFilters SubredditName
special = do
    Multireddit { Seq SubredditName
$sel:subreddits:Multireddit :: Multireddit -> Seq SubredditName
subreddits :: Seq SubredditName
subreddits } <- SubredditName -> m Multireddit
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> m Multireddit
listFilters SubredditName
special
    (SubredditName -> m ()) -> Seq SubredditName -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (SubredditName -> SubredditName -> m ()
forall (m :: * -> *).
MonadReddit m =>
SubredditName -> SubredditName -> m ()
removeFilter SubredditName
special) Seq SubredditName
subreddits

filterPath :: Username -> SubredditName -> [PathSegment]
filterPath :: Username -> SubredditName -> [PathSegment]
filterPath Username
uname SubredditName
sname =
    [ PathSegment
"api", PathSegment
"filter", PathSegment
"user", Username -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece Username
uname, PathSegment
"f", SubredditName -> PathSegment
forall a. ToHttpApiData a => a -> PathSegment
toUrlPiece SubredditName
sname ]