module Reddit
( runReddit
, runRedditAnon
, runRedditWith
, runResumeRedditWith
, interpretIO
, RedditOptions(..)
, defaultRedditOptions
, LoginMethod(..)
, 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
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
defaultRedditOptions :: RedditOptions
defaultRedditOptions :: RedditOptions
defaultRedditOptions = RedditOptions
forall a. Default a => a
def
data LoginMethod = Anonymous
| Credentials Text Text ClientParams
| StoredDetails LoginDetails
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
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 }
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
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
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
[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
, :: [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."