-- | This module should be most of what you need to operate the library.
--   It exports functionality for running built 'RedditT' actions, as well
--   as re-exporting a few helpful types from around the library. Not every
--   type is exported, however, due to clashing record fields. It's recommended
--   to import modules from @Reddit.Types.*@ qualified so that you can use all
--   the record fields without having to deal with ambiguous functions.
module Reddit
  ( runReddit
  , runRedditAnon
  , runRedditWith
  , runResumeRedditWith
  , interpretIO
  , RedditOptions(..)
  , defaultRedditOptions
  , LoginMethod(..)
  -- * Re-exports
  , APIError(..)
  , module Reddit.Actions
  , module Reddit.Types
  , module Reddit.Types.Error
  , module Reddit.Types.Reddit ) where

import Reddit.Actions
import Reddit.Login
import Reddit.Types.Error
import Reddit.Types
import Reddit.Types.Reddit hiding (info, should)

import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Free
import Data.ByteString.Char8 (ByteString)
import Data.Default.Class
import Data.Maybe (fromMaybe, isNothing)
import Data.Semigroup ((<>))
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Version
import Network.API.Builder as API
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Types
import Prelude hiding ((<>))
import qualified Data.ByteString.Char8 as BS

import qualified Paths_reddit

versionString :: ByteString
versionString :: ByteString
versionString =
  case Version
Paths_reddit.version of
    Version [Int]
xs [String]
_ -> ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"." ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> ByteString) -> [Int] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ByteString
BS.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int]
xs

-- | Options for how we should run the 'Reddit' action.
--
-- - 'rateLimitingEnabled': 'True' if the connection should be automatically rate-limited
--   and should pause when we hit the limit, 'False' otherwise. Default is 'True'.
--
-- - 'connectionManager': @'Just' x@ if the connection should use the 'Manager' @x@, 'Nothing'
--   if we should create a new one for the connection. Default is 'Nothing'.
--
-- - 'loginMethod': The method we should use for authentication, described in 'LoginMethod'.
--   Default is 'Anonymous'.
--
-- - 'customUserAgent': @'Just' "string"@ if the connection should use the user agent @"string"@,
--   @'Nothing'@ if it should use the default agent. Default is 'Nothing'.
data RedditOptions =
  RedditOptions { RedditOptions -> Bool
rateLimitingEnabled :: Bool
                , RedditOptions -> Maybe Manager
connectionManager :: Maybe Manager
                , RedditOptions -> LoginMethod
loginMethod :: LoginMethod
                , RedditOptions -> Maybe ByteString
customUserAgent :: Maybe ByteString }

instance Default RedditOptions where
  def :: RedditOptions
def = Bool
-> Maybe Manager
-> LoginMethod
-> Maybe ByteString
-> RedditOptions
RedditOptions Bool
True Maybe Manager
forall a. Maybe a
Nothing LoginMethod
Anonymous Maybe ByteString
forall a. Maybe a
Nothing

-- | The default set of options
defaultRedditOptions :: RedditOptions
defaultRedditOptions :: RedditOptions
defaultRedditOptions = RedditOptions
forall a. Default a => a
def

-- | Should we log in to Reddit? If so, should we use a stored set of credentials
--   or get a new fresh set?
data LoginMethod = Anonymous -- ^ Don't login, instead use an anonymous account
                 | Credentials Text Text ClientParams-- ^ Login using the specified username and password
                 | StoredDetails LoginDetails -- ^
                 --   Login using a stored set of credentials. Usually the best way to get
                 --   these is to do @'runRedditAnon' $ 'login' user pass@.
  deriving (Int -> LoginMethod -> ShowS
[LoginMethod] -> ShowS
LoginMethod -> String
(Int -> LoginMethod -> ShowS)
-> (LoginMethod -> String)
-> ([LoginMethod] -> ShowS)
-> Show LoginMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoginMethod] -> ShowS
$cshowList :: [LoginMethod] -> ShowS
show :: LoginMethod -> String
$cshow :: LoginMethod -> String
showsPrec :: Int -> LoginMethod -> ShowS
$cshowsPrec :: Int -> LoginMethod -> ShowS
Show)

instance Default LoginMethod where def :: LoginMethod
def = LoginMethod
Anonymous

-- | Run a 'Reddit' action (or a 'RedditT' transformer action). This uses the default logged-in settings
--   for 'RedditOptions': rate limiting enabled, default manager, login via username and password, and
--   the default user-agent. You should change the user agent if you're making anything more complex than
--   a basic script, since Reddit's API policy says that you should have a uniquely identifiable user agent.
runReddit :: MonadIO m => Text -> Text -> ClientParams -> RedditT m a -> m (Either (APIError RedditError) a)
runReddit :: Text
-> Text
-> ClientParams
-> RedditT m a
-> m (Either (APIError RedditError) a)
runReddit Text
user Text
pass ClientParams
cp = RedditOptions -> RedditT m a -> m (Either (APIError RedditError) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditOptions -> RedditT m a -> m (Either (APIError RedditError) a)
runRedditWith RedditOptions
forall a. Default a => a
def { loginMethod :: LoginMethod
loginMethod = Text -> Text -> ClientParams -> LoginMethod
Credentials Text
user Text
pass ClientParams
cp }

-- | Run a 'Reddit' action (or a 'RedditT' transformer action). This uses the default logged-out settings, so
--   you won't be able to do anything that requires authentication (like checking messages or making a post).
--   At the moment, authentication isn't statically checked, so it'll return a runtime error if you try to do
--   anything you don't have permissions for.
runRedditAnon :: MonadIO m => RedditT m a -> m (Either (APIError RedditError) a)
runRedditAnon :: RedditT m a -> m (Either (APIError RedditError) a)
runRedditAnon = RedditOptions -> RedditT m a -> m (Either (APIError RedditError) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditOptions -> RedditT m a -> m (Either (APIError RedditError) a)
runRedditWith RedditOptions
forall a. Default a => a
def

-- | Run a 'Reddit' or 'RedditT' action with custom settings. You probably won't need this function for
--   most things, but it's handy if you want to persist a connection over multiple 'Reddit' sessions or
--   use a custom user agent string.
runRedditWith :: MonadIO m => RedditOptions -> RedditT m a -> m (Either (APIError RedditError) a)
runRedditWith :: RedditOptions -> RedditT m a -> m (Either (APIError RedditError) a)
runRedditWith RedditOptions
opts RedditT m a
reddit = (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> Either (APIError RedditError) a)
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
-> m (Either (APIError RedditError) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (APIError RedditError, Maybe (RedditT m a)) a
-> Either (APIError RedditError) a
forall (m :: * -> *) a.
Either (APIError RedditError, Maybe (RedditT m a)) a
-> Either (APIError RedditError) a
dropResume (m (Either (APIError RedditError, Maybe (RedditT m a)) a)
 -> m (Either (APIError RedditError) a))
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
-> m (Either (APIError RedditError) a)
forall a b. (a -> b) -> a -> b
$ RedditOptions
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditOptions
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
runResumeRedditWith RedditOptions
opts RedditT m a
reddit

-- | Run a 'Reddit' or 'RedditT' action with custom settings. You probably won't need this function for
--   most things, but it's handy if you want to persist a connection over multiple 'Reddit' sessions or
--   use a custom user agent string.
runResumeRedditWith :: MonadIO m => RedditOptions -> RedditT m a -> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
runResumeRedditWith :: RedditOptions
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
runResumeRedditWith (RedditOptions Bool
rl Maybe Manager
man LoginMethod
lm Maybe ByteString
ua) RedditT m a
reddit = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ByteString
ua) m ()
forall (m :: * -> *). MonadIO m => m ()
customUAWarning
  Manager
manager <- case Maybe Manager
man of
    Just Manager
m -> Manager -> m Manager
forall (m :: * -> *) a. Monad m => a -> m a
return Manager
m
    Maybe Manager
Nothing -> IO Manager -> m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> m Manager) -> IO Manager -> m Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  Either
  (APIError RedditError, Maybe (RedditT m LoginDetails))
  (Maybe LoginDetails)
loginCreds <- case LoginMethod
lm of
    LoginMethod
Anonymous -> Either
  (APIError RedditError, Maybe (RedditT m LoginDetails))
  (Maybe LoginDetails)
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        (Maybe LoginDetails))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (APIError RedditError, Maybe (RedditT m LoginDetails))
   (Maybe LoginDetails)
 -> m (Either
         (APIError RedditError, Maybe (RedditT m LoginDetails))
         (Maybe LoginDetails)))
-> Either
     (APIError RedditError, Maybe (RedditT m LoginDetails))
     (Maybe LoginDetails)
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        (Maybe LoginDetails))
forall a b. (a -> b) -> a -> b
$ Maybe LoginDetails
-> Either
     (APIError RedditError, Maybe (RedditT m LoginDetails))
     (Maybe LoginDetails)
forall a b. b -> Either a b
Right Maybe LoginDetails
forall a. Maybe a
Nothing
    StoredDetails LoginDetails
ld -> Either
  (APIError RedditError, Maybe (RedditT m LoginDetails))
  (Maybe LoginDetails)
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        (Maybe LoginDetails))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (APIError RedditError, Maybe (RedditT m LoginDetails))
   (Maybe LoginDetails)
 -> m (Either
         (APIError RedditError, Maybe (RedditT m LoginDetails))
         (Maybe LoginDetails)))
-> Either
     (APIError RedditError, Maybe (RedditT m LoginDetails))
     (Maybe LoginDetails)
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        (Maybe LoginDetails))
forall a b. (a -> b) -> a -> b
$ Maybe LoginDetails
-> Either
     (APIError RedditError, Maybe (RedditT m LoginDetails))
     (Maybe LoginDetails)
forall a b. b -> Either a b
Right (Maybe LoginDetails
 -> Either
      (APIError RedditError, Maybe (RedditT m LoginDetails))
      (Maybe LoginDetails))
-> Maybe LoginDetails
-> Either
     (APIError RedditError, Maybe (RedditT m LoginDetails))
     (Maybe LoginDetails)
forall a b. (a -> b) -> a -> b
$ LoginDetails -> Maybe LoginDetails
forall a. a -> Maybe a
Just LoginDetails
ld
    Credentials Text
user Text
pass ClientParams
cp -> (Either
   (APIError RedditError, Maybe (RedditT m LoginDetails)) LoginDetails
 -> Either
      (APIError RedditError, Maybe (RedditT m LoginDetails))
      (Maybe LoginDetails))
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        LoginDetails)
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        (Maybe LoginDetails))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((LoginDetails -> Maybe LoginDetails)
-> Either
     (APIError RedditError, Maybe (RedditT m LoginDetails)) LoginDetails
-> Either
     (APIError RedditError, Maybe (RedditT m LoginDetails))
     (Maybe LoginDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LoginDetails -> Maybe LoginDetails
forall a. a -> Maybe a
Just) (m (Either
      (APIError RedditError, Maybe (RedditT m LoginDetails))
      LoginDetails)
 -> m (Either
         (APIError RedditError, Maybe (RedditT m LoginDetails))
         (Maybe LoginDetails)))
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        LoginDetails)
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        (Maybe LoginDetails))
forall a b. (a -> b) -> a -> b
$ RedditState
-> RedditT m LoginDetails
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        LoginDetails)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO (Text
-> Bool -> Manager -> [Header] -> Maybe LoginDetails -> RedditState
RedditState Text
loginBaseURL Bool
rl Manager
manager [] Maybe LoginDetails
forall a. Maybe a
Nothing) (RedditT m LoginDetails
 -> m (Either
         (APIError RedditError, Maybe (RedditT m LoginDetails))
         LoginDetails))
-> RedditT m LoginDetails
-> m (Either
        (APIError RedditError, Maybe (RedditT m LoginDetails))
        LoginDetails)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ClientParams -> RedditT m LoginDetails
forall (m :: * -> *).
Monad m =>
Text -> Text -> ClientParams -> RedditT m LoginDetails
login Text
user Text
pass ClientParams
cp
  case Either
  (APIError RedditError, Maybe (RedditT m LoginDetails))
  (Maybe LoginDetails)
loginCreds of
    Left (APIError RedditError
err, Maybe (RedditT m LoginDetails)
_) -> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ (APIError RedditError, Maybe (RedditT m a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. a -> Either a b
Left (APIError RedditError
err, RedditT m a -> Maybe (RedditT m a)
forall a. a -> Maybe a
Just RedditT m a
reddit)
    Right Maybe LoginDetails
lds ->
      RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO
        (Text
-> Bool -> Manager -> [Header] -> Maybe LoginDetails -> RedditState
RedditState Text
mainBaseURL Bool
rl Manager
manager [(HeaderName
"User-Agent", ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (ByteString
"reddit-haskell " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
versionString) Maybe ByteString
ua)] Maybe LoginDetails
lds) RedditT m a
reddit

interpretIO :: MonadIO m => RedditState -> RedditT m a -> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO :: RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate (RedditT FreeT (RedditF m) m a
r) =
  FreeT (RedditF m) m a
-> m (FreeF (RedditF m) a (FreeT (RedditF m) m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT FreeT (RedditF m) m a
r m (FreeF (RedditF m) a (FreeT (RedditF m) m a))
-> (FreeF (RedditF m) a (FreeT (RedditF m) m a)
    -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Pure a
x -> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. b -> Either a b
Right a
x
    Free (WithBaseURL Text
u RedditT m b
x b -> FreeT (RedditF m) m a
n) ->
      RedditState
-> RedditT m b
-> m (Either (APIError RedditError, Maybe (RedditT m b)) b)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO (RedditState
rstate { currentBaseURL :: Text
currentBaseURL = Text
u }) RedditT m b
x m (Either (APIError RedditError, Maybe (RedditT m b)) b)
-> (Either (APIError RedditError, Maybe (RedditT m b)) b
    -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left (APIError RedditError
err, Just RedditT m b
resume) ->
          Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ (APIError RedditError, Maybe (RedditT m a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. a -> Either a b
Left (APIError RedditError
err, RedditT m a -> Maybe (RedditT m a)
forall a. a -> Maybe a
Just (RedditT m a -> Maybe (RedditT m a))
-> RedditT m a -> Maybe (RedditT m a)
forall a b. (a -> b) -> a -> b
$ RedditT m b
resume RedditT m b -> (b -> RedditT m a) -> RedditT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> (b -> FreeT (RedditF m) m a) -> b -> RedditT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> FreeT (RedditF m) m a
n)
        Left (APIError RedditError
err, Maybe (RedditT m b)
Nothing) -> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ (APIError RedditError, Maybe (RedditT m a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. a -> Either a b
Left (APIError RedditError
err, Maybe (RedditT m a)
forall a. Maybe a
Nothing)
        Right b
res -> RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate (RedditT m a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ b -> FreeT (RedditF m) m a
n b
res
    Free (WithHeaders [Header] -> [Header]
hf RedditT m b
x b -> FreeT (RedditF m) m a
n) -> do
      RedditState
-> RedditT m b
-> m (Either (APIError RedditError, Maybe (RedditT m b)) b)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO (RedditState
rstate { extraHeaders :: [Header]
extraHeaders = [Header] -> [Header]
hf (RedditState -> [Header]
extraHeaders RedditState
rstate)}) RedditT m b
x m (Either (APIError RedditError, Maybe (RedditT m b)) b)
-> (Either (APIError RedditError, Maybe (RedditT m b)) b
    -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left (APIError RedditError
err, Just RedditT m b
resume) ->
          Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ (APIError RedditError, Maybe (RedditT m a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. a -> Either a b
Left (APIError RedditError
err, RedditT m a -> Maybe (RedditT m a)
forall a. a -> Maybe a
Just (RedditT m a -> Maybe (RedditT m a))
-> RedditT m a -> Maybe (RedditT m a)
forall a b. (a -> b) -> a -> b
$ RedditT m b
resume RedditT m b -> (b -> RedditT m a) -> RedditT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> (b -> FreeT (RedditF m) m a) -> b -> RedditT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> FreeT (RedditF m) m a
n)
        Left (APIError RedditError
err, Maybe (RedditT m b)
Nothing) -> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ (APIError RedditError, Maybe (RedditT m a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. a -> Either a b
Left (APIError RedditError
err, Maybe (RedditT m a)
forall a. Maybe a
Nothing)
        Right b
res -> RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate (RedditT m a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ b -> FreeT (RedditF m) m a
n b
res
    Free (FailWith APIError RedditError
x) -> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ (APIError RedditError, Maybe (RedditT m a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. a -> Either a b
Left (APIError RedditError
x, Maybe (RedditT m a)
forall a. Maybe a
Nothing)
    Free (Nest RedditT m b
x Either (APIError RedditError) b -> FreeT (RedditF m) m a
n) ->
      RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate (RedditT m a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall a b. (a -> b) -> a -> b
$ RedditT m b
-> (Either (APIError RedditError, Maybe (RedditT m b)) b
    -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a)
forall (m :: * -> *) b a.
RedditT m b
-> (Either (APIError RedditError, Maybe (RedditT m b)) b -> a)
-> RedditF m a
NestResuming RedditT m b
x (Either (APIError RedditError) b -> FreeT (RedditF m) m a
n (Either (APIError RedditError) b -> FreeT (RedditF m) m a)
-> (Either (APIError RedditError, Maybe (RedditT m b)) b
    -> Either (APIError RedditError) b)
-> Either (APIError RedditError, Maybe (RedditT m b)) b
-> FreeT (RedditF m) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (APIError RedditError, Maybe (RedditT m b)) b
-> Either (APIError RedditError) b
forall (m :: * -> *) a.
Either (APIError RedditError, Maybe (RedditT m a)) a
-> Either (APIError RedditError) a
dropResume)
    Free (NestResuming RedditT m b
x Either (APIError RedditError, Maybe (RedditT m b)) b
-> FreeT (RedditF m) m a
n) -> do
      Either (APIError RedditError, Maybe (RedditT m b)) b
res <- RedditState
-> RedditT m b
-> m (Either (APIError RedditError, Maybe (RedditT m b)) b)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate RedditT m b
x
      RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate (RedditT m a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ Either (APIError RedditError, Maybe (RedditT m b)) b
-> FreeT (RedditF m) m a
n Either (APIError RedditError, Maybe (RedditT m b)) b
res
    Free (RunRoute Route
route b -> FreeT (RedditF m) m a
n) ->
      RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate (RedditT m a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall a b. (a -> b) -> a -> b
$ Route
-> (JSONResponse b -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a)
forall b a (m :: * -> *).
Receivable b =>
Route -> (b -> a) -> RedditF m a
ReceiveRoute Route
route (b -> FreeT (RedditF m) m a
n (b -> FreeT (RedditF m) m a)
-> (JSONResponse b -> b) -> JSONResponse b -> FreeT (RedditF m) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONResponse b -> b
forall a. JSONResponse a -> a
unwrapJSON)
    Free (ReceiveRoute Route
route b -> FreeT (RedditF m) m a
n) ->
      Route -> RedditState -> m (Either (APIError RedditError) b)
forall (m :: * -> *) a.
(MonadIO m, Receivable a) =>
Route -> RedditState -> m (Either (APIError RedditError) a)
handleReceive Route
route RedditState
rstate m (Either (APIError RedditError) b)
-> (Either (APIError RedditError) b
    -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left err :: APIError RedditError
err@(APIError (RateLimitError Integer
secs Text
_)) ->
          if RedditState -> Bool
rateLimit RedditState
rstate
            then do
              IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
secs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
              RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate (RedditT m a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall a b. (a -> b) -> a -> b
$ Route
-> (b -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a)
forall b a (m :: * -> *).
Receivable b =>
Route -> (b -> a) -> RedditF m a
ReceiveRoute Route
route b -> FreeT (RedditF m) m a
n
            else Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ (APIError RedditError, Maybe (RedditT m a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. a -> Either a b
Left (APIError RedditError
err, RedditT m a -> Maybe (RedditT m a)
forall a. a -> Maybe a
Just (RedditT m a -> Maybe (RedditT m a))
-> RedditT m a -> Maybe (RedditT m a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall a b. (a -> b) -> a -> b
$ Route
-> (b -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a)
forall b a (m :: * -> *).
Receivable b =>
Route -> (b -> a) -> RedditF m a
ReceiveRoute Route
route b -> FreeT (RedditF m) m a
n)
        Left APIError RedditError
err -> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (APIError RedditError, Maybe (RedditT m a)) a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ (APIError RedditError, Maybe (RedditT m a))
-> Either (APIError RedditError, Maybe (RedditT m a)) a
forall a b. a -> Either a b
Left (APIError RedditError
err, RedditT m a -> Maybe (RedditT m a)
forall a. a -> Maybe a
Just (RedditT m a -> Maybe (RedditT m a))
-> RedditT m a -> Maybe (RedditT m a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a) -> FreeT (RedditF m) m a
forall a b. (a -> b) -> a -> b
$ Route
-> (b -> FreeT (RedditF m) m a)
-> RedditF m (FreeT (RedditF m) m a)
forall b a (m :: * -> *).
Receivable b =>
Route -> (b -> a) -> RedditF m a
ReceiveRoute Route
route b -> FreeT (RedditF m) m a
n)
        Right b
x -> RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall (m :: * -> *) a.
MonadIO m =>
RedditState
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
interpretIO RedditState
rstate (RedditT m a
 -> m (Either (APIError RedditError, Maybe (RedditT m a)) a))
-> RedditT m a
-> m (Either (APIError RedditError, Maybe (RedditT m a)) a)
forall a b. (a -> b) -> a -> b
$ FreeT (RedditF m) m a -> RedditT m a
forall (m :: * -> *) a. FreeT (RedditF m) m a -> RedditT m a
RedditT (FreeT (RedditF m) m a -> RedditT m a)
-> FreeT (RedditF m) m a -> RedditT m a
forall a b. (a -> b) -> a -> b
$ b -> FreeT (RedditF m) m a
n b
x

dropResume :: Either (APIError RedditError, Maybe (RedditT m a)) a -> Either (APIError RedditError) a
dropResume :: Either (APIError RedditError, Maybe (RedditT m a)) a
-> Either (APIError RedditError) a
dropResume (Left (APIError RedditError
x, Maybe (RedditT m a)
_)) = APIError RedditError -> Either (APIError RedditError) a
forall a b. a -> Either a b
Left APIError RedditError
x
dropResume (Right a
x) = a -> Either (APIError RedditError) a
forall a b. b -> Either a b
Right a
x

handleReceive :: (MonadIO m, Receivable a) => Route -> RedditState -> m (Either (APIError RedditError) a)
handleReceive :: Route -> RedditState -> m (Either (APIError RedditError) a)
handleReceive Route
r RedditState
rstate = do
  (Either (APIError RedditError) a
res, Builder
_, ()
_) <- Builder
-> Manager
-> ()
-> APIT () RedditError m a
-> m (Either (APIError RedditError) a, Builder, ())
forall (m :: * -> *) s e a.
MonadIO m =>
Builder
-> Manager
-> s
-> APIT s e m a
-> m (Either (APIError e) a, Builder, s)
runAPI (RedditState -> Builder
builderFromState RedditState
rstate) (RedditState -> Manager
connMgr RedditState
rstate) () (APIT () RedditError m a
 -> m (Either (APIError RedditError) a, Builder, ()))
-> APIT () RedditError m a
-> m (Either (APIError RedditError) a, Builder, ())
forall a b. (a -> b) -> a -> b
$
    Route -> APIT () RedditError m a
forall a e (m :: * -> *) s.
(Receivable a, ErrorReceivable e, MonadIO m) =>
Route -> APIT s e m a
API.runRoute Route
r
  Either (APIError RedditError) a
-> m (Either (APIError RedditError) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either (APIError RedditError) a
res

builderFromState :: RedditState -> Builder
builderFromState :: RedditState -> Builder
builderFromState (RedditState Text
burl Bool
_ Manager
_ [Header]
hdrs (Just (LoginDetails (Modhash Text
mh) CookieJar
cj))) =
  Text -> Text -> (Route -> Route) -> (Request -> Request) -> Builder
Builder Text
"Reddit" Text
burl Route -> Route
addAPIType ((Request -> Request) -> Builder)
-> (Request -> Request) -> Builder
forall a b. (a -> b) -> a -> b
$
    \Request
req -> [Header] -> Request -> Request
addHeaders ((HeaderName
"X-Modhash", Text -> ByteString
encodeUtf8 Text
mh)Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
:[Header]
hdrs) Request
req { cookieJar :: Maybe CookieJar
cookieJar = CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just CookieJar
cj }
builderFromState (RedditState Text
burl Bool
_ Manager
_ [Header]
hdrs Maybe LoginDetails
Nothing) =
  Text -> Text -> (Route -> Route) -> (Request -> Request) -> Builder
Builder Text
"Reddit" Text
burl Route -> Route
addAPIType ([Header] -> Request -> Request
addHeaders [Header]
hdrs)

addHeaders :: [Header] -> Request -> Request
addHeaders :: [Header] -> Request -> Request
addHeaders [Header]
xs Request
req = Request
req { requestHeaders :: [Header]
requestHeaders = Request -> [Header]
requestHeaders Request
req [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
xs }

data RedditState =
  RedditState { RedditState -> Text
currentBaseURL :: Text
              , RedditState -> Bool
rateLimit :: Bool
              , RedditState -> Manager
connMgr :: Manager
              , RedditState -> [Header]
extraHeaders :: [Header]
              , RedditState -> Maybe LoginDetails
_creds :: Maybe LoginDetails }

customUAWarning :: MonadIO m => m ()
customUAWarning :: m ()
customUAWarning = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  String -> IO ()
putStrLn String
"WARNING: You haven't specified a custom Reddit user agent!"
  String -> IO ()
putStrLn String
"           This is against Reddit's terms of service, and you should probably fix it."