{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      : Network.Reddit.User
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
-- Actions related to users, excluding the currently logged-in one. For actions
-- on the current account, see "Network.Reddit.Me"
--
module Network.Reddit.User
    (  -- * Actions
      isUsernameAvailable
    , getUser
    , getUserTrophies
    , getUserComments
    , getUserSubmissions
    , getUserUpvoted
    , getUserDownvoted
    , getUserHidden
    , getUserOverview
    , getUserGilded
    , getUserSaved
    , getUserMultireddits
    , getUserSubreddit
    , getUserModerated
    , gildUser
      -- ** User @Listing@s and summaries
      -- | These actions return @Listing@s for special user subreddits,
      -- user accounts, or 'UserSummary's for existing user IDs
    , getNewUsers
    , getPopularUsers
    , searchUsers
    , getUserSummaries
    , getUserSummary
      -- * Types
    , module M
    , Trophy
    ) where

import           Control.Monad                    ( (<=<), unless )
import           Control.Monad.Catch              ( MonadThrow(throwM) )

import           Data.Aeson                       ( FromJSON )
import qualified Data.Foldable                    as F
import           Data.Generics.Wrapped            ( wrappedTo )
import           Data.Ix                          ( Ix(inRange) )
import           Data.List.Split                  ( chunksOf )
import           Data.Maybe                       ( fromMaybe )
import           Data.Sequence                    ( Seq((:<|)) )
import           Data.Text                        ( Text )

import           Lens.Micro

import           Network.Reddit.Internal
import           Network.Reddit.Subreddit
import           Network.Reddit.Types
import           Network.Reddit.Types.Account
import           Network.Reddit.Types.Account     as M
                 ( AcceptPMs(..)
                 , Account(Account)
                 , AccountSearchOpts(AccountSearchOpts)
                 , AccountSearchSort(..)
                 , Friend(Friend)
                 , Karma(Karma)
                 , MediaPreference(..)
                 , Preferences(Preferences)
                 , UserID(UserID)
                 , UserSummary(UserSummary)
                 )
import           Network.Reddit.Types.Award
import           Network.Reddit.Types.Comment
import           Network.Reddit.Types.Internal    as M
                 ( Username
                 , mkUsername
                 )
import           Network.Reddit.Types.Item
import           Network.Reddit.Types.Multireddit
import           Network.Reddit.Types.Submission
import           Network.Reddit.Utils

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

-- | Check if a 'Username' is available for use
isUsernameAvailable :: MonadReddit m => Username -> m Bool
isUsernameAvailable :: Username -> m Bool
isUsernameAvailable Username
uname =
    APIAction Bool -> m Bool
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:requestData:APIAction :: WithData
requestData  = [(Text, Text)] -> WithData
mkTextFormData [ (Text
"user", Username -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Username
uname) ]
              , $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"api", Text
"username_available.json" ]
              , $sel:needsAuth:APIAction :: Bool
needsAuth    = Bool
False
              }

-- | Get information about another user
getUser :: MonadReddit m => Username -> m Account
getUser :: Username -> m Account
getUser Username
uname =
    APIAction Account -> m Account
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"user", Username -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Username
uname, Text
"about" ] }

-- | Get a user\'s 'Trophy's
getUserTrophies :: MonadReddit m => Username -> m (Seq Trophy)
getUserTrophies :: Username -> m (Seq Trophy)
getUserTrophies Username
uname = APIAction TrophyList -> m TrophyList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @TrophyList APIAction TrophyList
forall a. APIAction a
r m TrophyList -> (TrophyList -> Seq Trophy) -> m (Seq Trophy)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TrophyList -> Seq Trophy
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction a
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"user", Username -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Username
uname, Text
"trophies" ] }

-- | Get a 'Listing' of a user\'s 'Comment's
getUserComments :: MonadReddit m
                => Username
                -> Paginator CommentID Comment
                -> m (Listing CommentID Comment)
getUserComments :: Username
-> Paginator CommentID Comment -> m (Listing CommentID Comment)
getUserComments = Text
-> Username
-> Paginator CommentID Comment
-> m (Listing CommentID Comment)
forall (m :: * -> *) t a.
(MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) =>
Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
"comments"

-- | Get a 'Listing' of a user\'s 'Submission's
getUserSubmissions :: MonadReddit m
                   => Username
                   -> Paginator SubmissionID Submission
                   -> m (Listing SubmissionID Submission)
getUserSubmissions :: Username
-> Paginator SubmissionID Submission
-> m (Listing SubmissionID Submission)
getUserSubmissions = Text
-> Username
-> Paginator SubmissionID Submission
-> m (Listing SubmissionID Submission)
forall (m :: * -> *) t a.
(MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) =>
Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
"submitted"

getUserUpvoted, getUserDownvoted, getUserGilded
    :: MonadReddit m
    => Username
    -> Paginator ItemID Item
    -> m (Listing ItemID Item)

-- | Get 'Item's that a user has upvoted. You must be authorized to access this,
-- or an exception will be raised
getUserUpvoted :: Username -> Paginator ItemID Item -> m (Listing ItemID Item)
getUserUpvoted = Text
-> Username -> Paginator ItemID Item -> m (Listing ItemID Item)
forall (m :: * -> *) t a.
(MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) =>
Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
"upvoted"

-- | Get 'Item's that a user has upvoted. You must be authorized to access this,
-- or an exception will be raised
getUserDownvoted :: Username -> Paginator ItemID Item -> m (Listing ItemID Item)
getUserDownvoted = Text
-> Username -> Paginator ItemID Item -> m (Listing ItemID Item)
forall (m :: * -> *) t a.
(MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) =>
Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
"downvoted"

getUserHidden, getUserOverview, getUserSaved
    :: MonadReddit m
    => Username
    -> Paginator ItemID Item
    -> m (Listing ItemID Item)

-- | Get the 'Item's that a user has gilded
getUserGilded :: Username -> Paginator ItemID Item -> m (Listing ItemID Item)
getUserGilded = Text
-> Username -> Paginator ItemID Item -> m (Listing ItemID Item)
forall (m :: * -> *) t a.
(MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) =>
Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
"gilded"

-- | Get 'Item's that a user has hidden. You must be authorized to access this,
-- or an exception will be raised
getUserHidden :: Username -> Paginator ItemID Item -> m (Listing ItemID Item)
getUserHidden = Text
-> Username -> Paginator ItemID Item -> m (Listing ItemID Item)
forall (m :: * -> *) t a.
(MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) =>
Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
"hidden"

-- | Get an overview of a user\'s 'Comment's and 'Submission's
getUserOverview :: Username -> Paginator ItemID Item -> m (Listing ItemID Item)
getUserOverview = Text
-> Username -> Paginator ItemID Item -> m (Listing ItemID Item)
forall (m :: * -> *) t a.
(MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) =>
Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
"overview"

-- | Get the 'Item's that a user has saved. You must be authorized to access this,
-- or an exception will be raised
getUserSaved :: Username -> Paginator ItemID Item -> m (Listing ItemID Item)
getUserSaved = Text
-> Username -> Paginator ItemID Item -> m (Listing ItemID Item)
forall (m :: * -> *) t a.
(MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t) =>
Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
"saved"

userItems :: (MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t)
          => Text
          -> Username
          -> Paginator t a
          -> m (Listing t a)
userItems :: Text -> Username -> Paginator t a -> m (Listing t a)
userItems Text
path Username
uname Paginator t a
paginator =
    APIAction (Listing t a) -> m (Listing t a)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"user", Username -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Username
uname, Text
path ]
              , $sel:requestData:APIAction :: WithData
requestData  = Paginator t a -> WithData
forall t a. (Thing t, Paginable a) => Paginator t a -> WithData
paginatorToFormData Paginator t a
paginator
              }

-- | Get the public 'Multireddit's belonging to the given user
getUserMultireddits :: MonadReddit m => Username -> m (Seq Multireddit)
getUserMultireddits :: Username -> m (Seq Multireddit)
getUserMultireddits Username
uname =
    APIAction (Seq Multireddit) -> m (Seq Multireddit)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"api", Text
"multi", Text
"user", Username -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Username
uname ] }

-- | Get the special user 'Subreddit' for the given username
getUserSubreddit :: MonadReddit m => Username -> m Subreddit
getUserSubreddit :: Username -> m Subreddit
getUserSubreddit = SubredditName -> m Subreddit
forall (m :: * -> *). MonadReddit m => SubredditName -> m Subreddit
getSubreddit (SubredditName -> m Subreddit)
-> (Username -> m SubredditName) -> Username -> m Subreddit
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> m SubredditName
forall (m :: * -> *). MonadThrow m => Text -> m SubredditName
mkSubredditName (Text -> m SubredditName)
-> (Username -> Text) -> Username -> m SubredditName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Username -> Text
usernameToDisplayName

-- | Get a list of the subreddits that a user moderates
--
-- __Note__: Strangely, this will not include the user\'s special user subreddit
getUserModerated :: MonadReddit m => Username -> m (Seq Subreddit)
getUserModerated :: Username -> m (Seq Subreddit)
getUserModerated Username
uname = APIAction UserModeratedList -> m UserModeratedList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @UserModeratedList APIAction UserModeratedList
forall a. APIAction a
r m UserModeratedList
-> (UserModeratedList -> Seq Subreddit) -> m (Seq Subreddit)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UserModeratedList -> Seq Subreddit
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction a
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"user", Username -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Username
uname, Text
"moderated_subreddits" ]
        }

-- | Give the user Reddit gold, optionally specifying the duration
gildUser :: MonadReddit m
         => Maybe Word
         -- ^ Defaults to 1 when @Nothing@. Must be between 1 and 36
         -> Username
         -> m ()
gildUser :: Maybe Word -> Username -> m ()
gildUser (Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
1 -> Word
months) Username
uname = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Word, Word) -> Word -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Word
1, Word
36) Word
months) (m () -> m ())
-> (ClientException -> m ()) -> ClientException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
        (ClientException -> m ()) -> ClientException -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidRequest Text
"Duration must be between 1 and 36"
    APIAction () -> m ()
forall (m :: * -> *). MonadReddit m => APIAction () -> m ()
runAction_ APIAction Any
forall a. APIAction a
defaultAPIAction
               { $sel:pathSegments:APIAction :: [Text]
pathSegments =
                     [ Text
"api", Text
"v1", Text
"gold", Text
"give", Username -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Username
uname ]
               , $sel:method:APIAction :: Method
method       = Method
POST
               , $sel:requestData:APIAction :: WithData
requestData  =
                     [(Text, Text)] -> WithData
mkTextFormData [ (Text
"months", Word -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Word
months) ]
               }

-- | Get a @Listing@ of special user subreddits, sorted on creation date (newest
-- first)
getNewUsers :: MonadReddit m
            => Paginator SubredditID Subreddit
            -> m (Listing SubredditID Subreddit)
getNewUsers :: Paginator SubredditID Subreddit
-> m (Listing SubredditID Subreddit)
getNewUsers Paginator SubredditID Subreddit
paginator =
    APIAction (Listing SubredditID Subreddit)
-> m (Listing SubredditID Subreddit)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"users", Text
"new" ]
              , $sel:requestData:APIAction :: WithData
requestData  = Paginator SubredditID Subreddit -> WithData
forall t a. (Thing t, Paginable a) => Paginator t a -> WithData
paginatorToFormData Paginator SubredditID Subreddit
paginator
              }

-- | Get a @Listing@ of special user subreddits, sorted on popularity
getPopularUsers :: MonadReddit m
                => Paginator SubredditID Subreddit
                -> m (Listing SubredditID Subreddit)
getPopularUsers :: Paginator SubredditID Subreddit
-> m (Listing SubredditID Subreddit)
getPopularUsers Paginator SubredditID Subreddit
paginator =
    APIAction (Listing SubredditID Subreddit)
-> m (Listing SubredditID Subreddit)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"users", Text
"new" ]
              , $sel:requestData:APIAction :: WithData
requestData  = Paginator SubredditID Subreddit -> WithData
forall t a. (Thing t, Paginable a) => Paginator t a -> WithData
paginatorToFormData Paginator SubredditID Subreddit
paginator
              }

-- | Get a @Listing@ of user profiles whose titles and descriptions which match
-- the given @query@
searchUsers :: MonadReddit m
            => Text
            -> Paginator UserID Account
            -> m (Listing UserID Account)
searchUsers :: Text -> Paginator UserID Account -> m (Listing UserID Account)
searchUsers Text
query Paginator UserID Account
paginator =
    APIAction (Listing UserID Account) -> m (Listing UserID Account)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"users", Text
"search" ]
              , $sel:requestData:APIAction :: WithData
requestData  =
                    Form -> WithData
WithForm (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Form
mkTextForm [ (Text
"q", Text
query) ] Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Paginator UserID Account -> Form
forall a. ToForm a => a -> Form
toForm Paginator UserID Account
paginator
              }

-- | Get a brief 'UserSummary' for each valid 'UserID'. Note that Reddit silently
-- ignores invalid IDs, so the output may be shorted than the input container
getUserSummaries
    :: (MonadReddit m, Foldable t) => t UserID -> m (Seq UserSummary)
getUserSummaries :: t UserID -> m (Seq UserSummary)
getUserSummaries t UserID
uids = [Seq UserSummary] -> Seq UserSummary
forall a. Monoid a => [a] -> a
mconcat ([Seq UserSummary] -> Seq UserSummary)
-> m [Seq UserSummary] -> m (Seq UserSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([UserID] -> m (Seq UserSummary))
-> [[UserID]] -> m [Seq UserSummary]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [UserID] -> m (Seq UserSummary)
forall (f :: * -> *) a.
(MonadReader Client f, MonadCatch f, MonadUnliftIO f, Thing a) =>
a -> f (Seq UserSummary)
mkAction (t UserID -> [[UserID]]
forall e. t e -> [[e]]
chunked t UserID
uids)
  where
    chunked :: t e -> [[e]]
chunked = Int -> [e] -> [[e]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
forall n. Num n => n
apiRequestLimit ([e] -> [[e]]) -> (t e -> [e]) -> t e -> [[e]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

    mkAction :: a -> f (Seq UserSummary)
mkAction a
ids = APIAction UserSummaryList -> f UserSummaryList
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @UserSummaryList APIAction UserSummaryList
forall a. APIAction a
r f UserSummaryList
-> (UserSummaryList -> Seq UserSummary) -> f (Seq UserSummary)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UserSummaryList -> Seq UserSummary
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
      where
        r :: APIAction a
r = APIAction Any
forall a. APIAction a
defaultAPIAction
            { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"api", Text
"user_data_by_account_ids" ]
            , $sel:requestData:APIAction :: WithData
requestData  = [(Text, Text)] -> WithData
mkTextFormData [ (Text
"ids", a -> Text
forall a. Thing a => a -> Text
fullname a
ids) ]
            }

-- | Get the 'UserSummary' for a single user ID
getUserSummary :: MonadReddit m => UserID -> m UserSummary
getUserSummary :: UserID -> m UserSummary
getUserSummary UserID
uid = [UserID] -> m (Seq UserSummary)
forall (m :: * -> *) (t :: * -> *).
(MonadReddit m, Foldable t) =>
t UserID -> m (Seq UserSummary)
getUserSummaries [ UserID
uid ] m (Seq UserSummary)
-> (Seq UserSummary -> m UserSummary) -> m UserSummary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    UserSummary
us :<| Seq UserSummary
_ -> UserSummary -> m UserSummary
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserSummary
us
    Seq UserSummary
_        -> ClientException -> m UserSummary
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m UserSummary)
-> ClientException -> m UserSummary
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidResponse Text
"getUserSummary: No such user"