{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Web.Twitter.Conduit.Base (
    ResponseBodyType (..),
    NoContent,
    getResponse,
    call,
    call',
    callWithResponse,
    callWithResponse',
    checkResponse,
    sourceWithMaxId,
    sourceWithMaxId',
    sourceWithCursor,
    sourceWithCursor',
    sourceWithSearchResult,
    sourceWithSearchResult',
    endpoint,
    makeRequest,
    sinkJSON,
    sinkFromJSON,
) where

import Web.Twitter.Conduit.Cursor
import Web.Twitter.Conduit.Request
import Web.Twitter.Conduit.Request.Internal
import Web.Twitter.Conduit.Response
import Web.Twitter.Conduit.Types
import Web.Twitter.Types.Lens

import Control.Lens
import Control.Monad (void)
import Control.Monad.Catch (MonadThrow (..))
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)
import Data.Aeson
import Data.Aeson.Lens
import Data.ByteString (ByteString)
import Data.Coerce
import qualified Data.Conduit as C
import qualified Data.Conduit.Attoparsec as CA
import qualified Data.Conduit.List as CL
import qualified Data.Map as M
import qualified Data.Text.Encoding as T
import GHC.TypeLits (KnownSymbol)
import Network.HTTP.Client.MultipartFormData
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Types as HT
import Web.Authenticate.OAuth (signOAuth)

makeRequest ::
    APIRequest apiName responseType ->
    IO HTTP.Request
makeRequest :: APIRequest apiName responseType -> IO Request
makeRequest (APIRequest Method
m String
u APIQuery
pa) = Method -> String -> SimpleQuery -> IO Request
makeRequest' Method
m String
u (APIQuery -> SimpleQuery
makeSimpleQuery APIQuery
pa)
makeRequest (APIRequestMultipart Method
m String
u APIQuery
param [Part]
prt) =
    [Part] -> Request -> IO Request
forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
formDataBody [Part]
body (Request -> IO Request) -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Method -> String -> SimpleQuery -> IO Request
makeRequest' Method
m String
u []
  where
    body :: [Part]
body = [Part]
prt [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
partParam
    partParam :: [Part]
partParam = (SimpleQueryItem -> Part) -> SimpleQuery -> [Part]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ((Text -> Method -> Part) -> (Text, Method) -> Part
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Method -> Part
forall (m :: * -> *). Applicative m => Text -> Method -> PartM m
partBS ((Text, Method) -> Part)
-> (SimpleQueryItem -> (Text, Method)) -> SimpleQueryItem -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter SimpleQueryItem (Text, Method) Method Text
-> (Method -> Text) -> SimpleQueryItem -> (Text, Method)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter SimpleQueryItem (Text, Method) Method Text
forall s t a b. Field1 s t a b => Lens s t a b
_1 Method -> Text
T.decodeUtf8) (APIQuery -> SimpleQuery
makeSimpleQuery APIQuery
param)
makeRequest (APIRequestJSON Method
m String
u APIQuery
param Value
body) = do
    Request
req <- Method -> String -> SimpleQuery -> IO Request
makeRequest' Method
m String
u (APIQuery -> SimpleQuery
makeSimpleQuery APIQuery
param)
    Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$
        Request
req
            { requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
body
            , requestHeaders :: RequestHeaders
HTTP.requestHeaders = (HeaderName
"Content-Type", Method
"application/json") (HeaderName, Method) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
HTTP.requestHeaders Request
req
            }

makeRequest' ::
    -- | HTTP request method (GET or POST)
    HT.Method ->
    -- | API Resource URL
    String ->
    -- | Query
    HT.SimpleQuery ->
    IO HTTP.Request
makeRequest' :: Method -> String -> SimpleQuery -> IO Request
makeRequest' Method
m String
url SimpleQuery
query = do
    Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseRequest String
url
    let addParams :: Request -> Request
addParams =
            if Method
m Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
"POST"
                then SimpleQuery -> Request -> Request
HTTP.urlEncodedBody SimpleQuery
query
                else \Request
r -> Request
r {queryString :: Method
HTTP.queryString = Bool -> SimpleQuery -> Method
HT.renderSimpleQuery Bool
False SimpleQuery
query}
    Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$ Request -> Request
addParams (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
req {method :: Method
HTTP.method = Method
m}

class ResponseBodyType a where
    parseResponseBody ::
        Response (C.ConduitM () ByteString (ResourceT IO) ()) ->
        ResourceT IO (Response a)

type NoContent = ()
instance ResponseBodyType NoContent where
    parseResponseBody :: Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response ())
parseResponseBody Response (ConduitM () Method (ResourceT IO) ())
res =
        case Response (ConduitM () Method (ResourceT IO) ()) -> Status
forall responseType. Response responseType -> Status
responseStatus Response (ConduitM () Method (ResourceT IO) ())
res of
            Status
st | Status
st Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
HT.status204 -> Response () -> ResourceT IO (Response ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Response () -> ResourceT IO (Response ()))
-> Response () -> ResourceT IO (Response ())
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () Method (ResourceT IO) ()) -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response (ConduitM () Method (ResourceT IO) ())
res
            Status
_ -> do
                Value
body <- ConduitT () Void (ResourceT IO) Value -> ResourceT IO Value
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit (ConduitT () Void (ResourceT IO) Value -> ResourceT IO Value)
-> ConduitT () Void (ResourceT IO) Value -> ResourceT IO Value
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () Method (ResourceT IO) ())
-> ConduitM () Method (ResourceT IO) ()
forall responseType. Response responseType -> responseType
responseBody Response (ConduitM () Method (ResourceT IO) ())
res ConduitM () Method (ResourceT IO) ()
-> ConduitM Method Void (ResourceT IO) Value
-> ConduitT () Void (ResourceT IO) Value
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM Method Void (ResourceT IO) Value
forall (m :: * -> *) o. MonadThrow m => ConduitT Method o m Value
sinkJSON
                TwitterError -> ResourceT IO (Response ())
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TwitterError -> ResourceT IO (Response ()))
-> TwitterError -> ResourceT IO (Response ())
forall a b. (a -> b) -> a -> b
$ Status -> RequestHeaders -> Value -> TwitterError
TwitterStatusError (Response (ConduitM () Method (ResourceT IO) ()) -> Status
forall responseType. Response responseType -> Status
responseStatus Response (ConduitM () Method (ResourceT IO) ())
res) (Response (ConduitM () Method (ResourceT IO) ()) -> RequestHeaders
forall responseType. Response responseType -> RequestHeaders
responseHeaders Response (ConduitM () Method (ResourceT IO) ())
res) Value
body

instance {-# OVERLAPPABLE #-} FromJSON a => ResponseBodyType a where
    parseResponseBody :: Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response a)
parseResponseBody = Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response a)
forall a.
FromJSON a =>
Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response a)
getValueOrThrow

getResponse ::
    MonadResource m =>
    TWInfo ->
    HTTP.Manager ->
    HTTP.Request ->
    m (Response (C.ConduitM () ByteString m ()))
getResponse :: TWInfo
-> Manager -> Request -> m (Response (ConduitM () Method m ()))
getResponse TWInfo {Maybe Proxy
TWToken
twProxy :: TWInfo -> Maybe Proxy
twToken :: TWInfo -> TWToken
twProxy :: Maybe Proxy
twToken :: TWToken
..} Manager
mgr Request
req = do
    Request
signedReq <- OAuth -> Credential -> Request -> m Request
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m Request
signOAuth (TWToken -> OAuth
twOAuth TWToken
twToken) (TWToken -> Credential
twCredential TWToken
twToken) (Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request
req {proxy :: Maybe Proxy
HTTP.proxy = Maybe Proxy
twProxy}
    Response (ConduitM () Method m ())
res <- Request -> Manager -> m (Response (ConduitM () Method m ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i Method m ()))
HTTP.http Request
signedReq Manager
mgr
    Response (ConduitM () Method m ())
-> m (Response (ConduitM () Method m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return
        Response :: forall responseType.
Status -> RequestHeaders -> responseType -> Response responseType
Response
            { responseStatus :: Status
responseStatus = Response (ConduitM () Method m ()) -> Status
forall body. Response body -> Status
HTTP.responseStatus Response (ConduitM () Method m ())
res
            , responseHeaders :: RequestHeaders
responseHeaders = Response (ConduitM () Method m ()) -> RequestHeaders
forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () Method m ())
res
            , responseBody :: ConduitM () Method m ()
responseBody = Response (ConduitM () Method m ()) -> ConduitM () Method m ()
forall body. Response body -> body
HTTP.responseBody Response (ConduitM () Method m ())
res
            }

endpoint :: String
endpoint :: String
endpoint = String
"https://api.twitter.com/1.1/"

getValue ::
    Response (C.ConduitM () ByteString (ResourceT IO) ()) ->
    ResourceT IO (Response Value)
getValue :: Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response Value)
getValue Response (ConduitM () Method (ResourceT IO) ())
res = do
    Value
value <-
        ConduitT () Void (ResourceT IO) Value -> ResourceT IO Value
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit (ConduitT () Void (ResourceT IO) Value -> ResourceT IO Value)
-> ConduitT () Void (ResourceT IO) Value -> ResourceT IO Value
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () Method (ResourceT IO) ())
-> ConduitM () Method (ResourceT IO) ()
forall responseType. Response responseType -> responseType
responseBody Response (ConduitM () Method (ResourceT IO) ())
res ConduitM () Method (ResourceT IO) ()
-> ConduitM Method Void (ResourceT IO) Value
-> ConduitT () Void (ResourceT IO) Value
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM Method Void (ResourceT IO) Value
forall (m :: * -> *) o. MonadThrow m => ConduitT Method o m Value
sinkJSON
    Response Value -> ResourceT IO (Response Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response Value -> ResourceT IO (Response Value))
-> Response Value -> ResourceT IO (Response Value)
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () Method (ResourceT IO) ())
res {responseBody :: Value
responseBody = Value
value}

checkResponse ::
    Response Value ->
    Either TwitterError Value
checkResponse :: Response Value -> Either TwitterError Value
checkResponse Response {RequestHeaders
Value
Status
responseBody :: Value
responseHeaders :: RequestHeaders
responseStatus :: Status
responseHeaders :: forall responseType. Response responseType -> RequestHeaders
responseBody :: forall responseType. Response responseType -> responseType
responseStatus :: forall responseType. Response responseType -> Status
..} =
    case Value
responseBody Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"errors" of
        Just errs :: Value
errs@(Array Array
_) ->
            case Value -> Result [TwitterErrorMessage]
forall a. FromJSON a => Value -> Result a
fromJSON Value
errs of
                Success [TwitterErrorMessage]
errList -> TwitterError -> Either TwitterError Value
forall a b. a -> Either a b
Left (TwitterError -> Either TwitterError Value)
-> TwitterError -> Either TwitterError Value
forall a b. (a -> b) -> a -> b
$ Status -> RequestHeaders -> [TwitterErrorMessage] -> TwitterError
TwitterErrorResponse Status
responseStatus RequestHeaders
responseHeaders [TwitterErrorMessage]
errList
                Error String
msg -> TwitterError -> Either TwitterError Value
forall a b. a -> Either a b
Left (TwitterError -> Either TwitterError Value)
-> TwitterError -> Either TwitterError Value
forall a b. (a -> b) -> a -> b
$ String -> TwitterError
FromJSONError String
msg
        Just Value
err ->
            TwitterError -> Either TwitterError Value
forall a b. a -> Either a b
Left (TwitterError -> Either TwitterError Value)
-> TwitterError -> Either TwitterError Value
forall a b. (a -> b) -> a -> b
$ Status -> RequestHeaders -> Value -> TwitterError
TwitterUnknownErrorResponse Status
responseStatus RequestHeaders
responseHeaders Value
err
        Maybe Value
Nothing ->
            if Int
sci Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
200 Bool -> Bool -> Bool
|| Int
sci Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
400
                then TwitterError -> Either TwitterError Value
forall a b. a -> Either a b
Left (TwitterError -> Either TwitterError Value)
-> TwitterError -> Either TwitterError Value
forall a b. (a -> b) -> a -> b
$ Status -> RequestHeaders -> Value -> TwitterError
TwitterStatusError Status
responseStatus RequestHeaders
responseHeaders Value
responseBody
                else Value -> Either TwitterError Value
forall a b. b -> Either a b
Right Value
responseBody
  where
    sci :: Int
sci = Status -> Int
HT.statusCode Status
responseStatus

getValueOrThrow ::
    FromJSON a =>
    Response (C.ConduitM () ByteString (ResourceT IO) ()) ->
    ResourceT IO (Response a)
getValueOrThrow :: Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response a)
getValueOrThrow Response (ConduitM () Method (ResourceT IO) ())
res = do
    Response Value
res' <- Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response Value)
getValue Response (ConduitM () Method (ResourceT IO) ())
res
    case Response Value -> Either TwitterError Value
checkResponse Response Value
res' of
        Left TwitterError
err -> TwitterError -> ResourceT IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TwitterError
err
        Right Value
_ -> () -> ResourceT IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON (Response Value -> Value
forall responseType. Response responseType -> responseType
responseBody Response Value
res') of
        Success a
r -> Response a -> ResourceT IO (Response a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response a -> ResourceT IO (Response a))
-> Response a -> ResourceT IO (Response a)
forall a b. (a -> b) -> a -> b
$ Response Value
res' {responseBody :: a
responseBody = a
r}
        Error String
err -> TwitterError -> ResourceT IO (Response a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TwitterError -> ResourceT IO (Response a))
-> TwitterError -> ResourceT IO (Response a)
forall a b. (a -> b) -> a -> b
$ String -> TwitterError
FromJSONError String
err

-- | Perform an 'APIRequest' and then provide the response which is mapped to a suitable type of
-- <http://hackage.haskell.org/package/twitter-types twitter-types>.
--
-- Example:
--
-- @
-- user <- 'call' twInfo mgr $ 'accountVerifyCredentials'
-- print user
-- @
--
-- If you need raw JSON value which is parsed by <http://hackage.haskell.org/package/aeson aeson>,
-- use 'call'' to obtain it.
call ::
    ResponseBodyType responseType =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest apiName responseType ->
    IO responseType
call :: TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
call = TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
forall value (apiName :: [Param Symbol *]) responseType.
ResponseBodyType value =>
TWInfo -> Manager -> APIRequest apiName responseType -> IO value
call'

-- | Perform an 'APIRequest' and then provide the response.
-- The response of this function is not restrict to @responseType@,
-- so you can choose an arbitrarily type of FromJSON instances.
call' ::
    ResponseBodyType value =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest apiName responseType ->
    IO value
call' :: TWInfo -> Manager -> APIRequest apiName responseType -> IO value
call' TWInfo
info Manager
mgr APIRequest apiName responseType
req = Response value -> value
forall responseType. Response responseType -> responseType
responseBody (Response value -> value) -> IO (Response value) -> IO value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TWInfo
-> Manager
-> APIRequest apiName responseType
-> IO (Response value)
forall value (apiName :: [Param Symbol *]) responseType.
ResponseBodyType value =>
TWInfo
-> Manager
-> APIRequest apiName responseType
-> IO (Response value)
callWithResponse' TWInfo
info Manager
mgr APIRequest apiName responseType
req

-- | Perform an 'APIRequest' and then provide the 'Response'.
--
-- Example:
--
-- @
-- res \<- 'callWithResponse' twInfo mgr $ 'accountVerifyCredentials'
-- 'print' $ 'responseStatus' res
-- 'print' $ 'responseHeaders' res
-- 'print' $ 'responseBody' res
-- @
callWithResponse ::
    ResponseBodyType responseType =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest apiName responseType ->
    IO (Response responseType)
callWithResponse :: TWInfo
-> Manager
-> APIRequest apiName responseType
-> IO (Response responseType)
callWithResponse = TWInfo
-> Manager
-> APIRequest apiName responseType
-> IO (Response responseType)
forall value (apiName :: [Param Symbol *]) responseType.
ResponseBodyType value =>
TWInfo
-> Manager
-> APIRequest apiName responseType
-> IO (Response value)
callWithResponse'

-- | Perform an 'APIRequest' and then provide the 'Response'.
-- The response of this function is not restrict to @responseType@,
-- so you can choose an arbitrarily type of FromJSON instances.
--
-- Example:
--
-- @
-- res \<- 'callWithResponse'' twInfo mgr $ 'accountVerifyCredentials'
-- 'print' $ 'responseStatus' res
-- 'print' $ 'responseHeaders' res
-- 'print' $ 'responseBody' (res :: Value)
-- @
callWithResponse' ::
    ResponseBodyType value =>
    TWInfo ->
    HTTP.Manager ->
    APIRequest apiName responseType ->
    IO (Response value)
callWithResponse' :: TWInfo
-> Manager
-> APIRequest apiName responseType
-> IO (Response value)
callWithResponse' TWInfo
info Manager
mgr APIRequest apiName responseType
req =
    ResourceT IO (Response value) -> IO (Response value)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Response value) -> IO (Response value))
-> ResourceT IO (Response value) -> IO (Response value)
forall a b. (a -> b) -> a -> b
$ do
        Response (ConduitM () Method (ResourceT IO) ())
res <- TWInfo
-> Manager
-> Request
-> ResourceT IO (Response (ConduitM () Method (ResourceT IO) ()))
forall (m :: * -> *).
MonadResource m =>
TWInfo
-> Manager -> Request -> m (Response (ConduitM () Method m ()))
getResponse TWInfo
info Manager
mgr (Request
 -> ResourceT IO (Response (ConduitM () Method (ResourceT IO) ())))
-> ResourceT IO Request
-> ResourceT IO (Response (ConduitM () Method (ResourceT IO) ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Request -> ResourceT IO Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (APIRequest apiName responseType -> IO Request
forall (apiName :: [Param Symbol *]) responseType.
APIRequest apiName responseType -> IO Request
makeRequest APIRequest apiName responseType
req)
        Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response value)
forall a.
ResponseBodyType a =>
Response (ConduitM () Method (ResourceT IO) ())
-> ResourceT IO (Response a)
parseResponseBody Response (ConduitM () Method (ResourceT IO) ())
res

-- | A wrapper function to perform multiple API request with changing @max_id@ parameter.
--
-- This function cooperate with instances of 'HasMaxIdParam'.
sourceWithMaxId ::
    ( MonadIO m
    , FromJSON responseType
    , AsStatus responseType
    , HasParam "max_id" Integer supports
    ) =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest supports [responseType] ->
    C.ConduitT () responseType m ()
sourceWithMaxId :: TWInfo
-> Manager
-> APIRequest supports [responseType]
-> ConduitT () responseType m ()
sourceWithMaxId TWInfo
info Manager
mgr = APIRequest supports [responseType] -> ConduitT () responseType m ()
loop
  where
    loop :: APIRequest supports [responseType] -> ConduitT () responseType m ()
loop APIRequest supports [responseType]
req = do
        [responseType]
res <- IO [responseType] -> ConduitT () responseType m [responseType]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [responseType] -> ConduitT () responseType m [responseType])
-> IO [responseType] -> ConduitT () responseType m [responseType]
forall a b. (a -> b) -> a -> b
$ TWInfo
-> Manager
-> APIRequest supports [responseType]
-> IO [responseType]
forall responseType (apiName :: [Param Symbol *]).
ResponseBodyType responseType =>
TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
call TWInfo
info Manager
mgr APIRequest supports [responseType]
req
        case [responseType] -> Maybe StatusId
getMinId [responseType]
res of
            Just StatusId
mid -> do
                [responseType] -> ConduitT () responseType m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList [responseType]
res
                APIRequest supports [responseType] -> ConduitT () responseType m ()
loop (APIRequest supports [responseType]
 -> ConduitT () responseType m ())
-> APIRequest supports [responseType]
-> ConduitT () responseType m ()
forall a b. (a -> b) -> a -> b
$ APIRequest supports [responseType]
req APIRequest supports [responseType]
-> (APIRequest supports [responseType]
    -> APIRequest supports [responseType])
-> APIRequest supports [responseType]
forall a b. a -> (a -> b) -> b
& IsLabel
  "max_id"
  (ASetter
     (APIRequest supports [responseType])
     (APIRequest supports [responseType])
     (Maybe StatusId)
     (Maybe StatusId))
ASetter
  (APIRequest supports [responseType])
  (APIRequest supports [responseType])
  (Maybe StatusId)
  (Maybe StatusId)
#max_id ASetter
  (APIRequest supports [responseType])
  (APIRequest supports [responseType])
  (Maybe StatusId)
  (Maybe StatusId)
-> StatusId
-> APIRequest supports [responseType]
-> APIRequest supports [responseType]
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StatusId
mid StatusId -> StatusId -> StatusId
forall a. Num a => a -> a -> a
- StatusId
1
            Maybe StatusId
Nothing -> [responseType] -> ConduitT () responseType m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList [responseType]
res
    getMinId :: [responseType] -> Maybe StatusId
getMinId = Getting (Endo (Endo (Maybe StatusId))) [responseType] StatusId
-> [responseType] -> Maybe StatusId
forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
minimumOf ((responseType -> Const (Endo (Endo (Maybe StatusId))) responseType)
-> [responseType]
-> Const (Endo (Endo (Maybe StatusId))) [responseType]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((responseType
  -> Const (Endo (Endo (Maybe StatusId))) responseType)
 -> [responseType]
 -> Const (Endo (Endo (Maybe StatusId))) [responseType])
-> ((StatusId -> Const (Endo (Endo (Maybe StatusId))) StatusId)
    -> responseType
    -> Const (Endo (Endo (Maybe StatusId))) responseType)
-> Getting (Endo (Endo (Maybe StatusId))) [responseType] StatusId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StatusId -> Const (Endo (Endo (Maybe StatusId))) StatusId)
-> responseType
-> Const (Endo (Endo (Maybe StatusId))) responseType
forall s. AsStatus s => Lens' s StatusId
status_id)

-- | A wrapper function to perform multiple API request with changing @max_id@ parameter.
-- The response of this function is not restrict to @responseType@,
-- so you can choose an arbitrarily type of FromJSON instances.
--
-- This function cooperate with instances of 'HasMaxIdParam'.
sourceWithMaxId' ::
    ( MonadIO m
    , HasParam "max_id" Integer supports
    ) =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest supports [responseType] ->
    C.ConduitT () Value m ()
sourceWithMaxId' :: TWInfo
-> Manager
-> APIRequest supports [responseType]
-> ConduitT () Value m ()
sourceWithMaxId' TWInfo
info Manager
mgr = APIRequest supports [responseType] -> ConduitT () Value m ()
loop
  where
    loop :: APIRequest supports [responseType] -> ConduitT () Value m ()
loop APIRequest supports [responseType]
req = do
        ([Value]
res :: [Value]) <- IO [Value] -> ConduitT () Value m [Value]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Value] -> ConduitT () Value m [Value])
-> IO [Value] -> ConduitT () Value m [Value]
forall a b. (a -> b) -> a -> b
$ TWInfo
-> Manager -> APIRequest supports [responseType] -> IO [Value]
forall value (apiName :: [Param Symbol *]) responseType.
ResponseBodyType value =>
TWInfo -> Manager -> APIRequest apiName responseType -> IO value
call' TWInfo
info Manager
mgr APIRequest supports [responseType]
req
        case Getting (Endo (Endo (Maybe StatusId))) [Value] StatusId
-> [Value] -> Maybe StatusId
forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
minimumOf ((Value -> Const (Endo (Endo (Maybe StatusId))) Value)
-> [Value] -> Const (Endo (Endo (Maybe StatusId))) [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Value -> Const (Endo (Endo (Maybe StatusId))) Value)
 -> [Value] -> Const (Endo (Endo (Maybe StatusId))) [Value])
-> ((StatusId -> Const (Endo (Endo (Maybe StatusId))) StatusId)
    -> Value -> Const (Endo (Endo (Maybe StatusId))) Value)
-> Getting (Endo (Endo (Maybe StatusId))) [Value] StatusId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"id" ((Value -> Const (Endo (Endo (Maybe StatusId))) Value)
 -> Value -> Const (Endo (Endo (Maybe StatusId))) Value)
-> ((StatusId -> Const (Endo (Endo (Maybe StatusId))) StatusId)
    -> Value -> Const (Endo (Endo (Maybe StatusId))) Value)
-> (StatusId -> Const (Endo (Endo (Maybe StatusId))) StatusId)
-> Value
-> Const (Endo (Endo (Maybe StatusId))) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StatusId -> Const (Endo (Endo (Maybe StatusId))) StatusId)
-> Value -> Const (Endo (Endo (Maybe StatusId))) Value
forall t. AsNumber t => Prism' t StatusId
_Integer) [Value]
res of
            Just StatusId
mid -> do
                [Value] -> ConduitT () Value m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList [Value]
res
                APIRequest supports [responseType] -> ConduitT () Value m ()
loop (APIRequest supports [responseType] -> ConduitT () Value m ())
-> APIRequest supports [responseType] -> ConduitT () Value m ()
forall a b. (a -> b) -> a -> b
$ APIRequest supports [responseType]
req APIRequest supports [responseType]
-> (APIRequest supports [responseType]
    -> APIRequest supports [responseType])
-> APIRequest supports [responseType]
forall a b. a -> (a -> b) -> b
& IsLabel
  "max_id"
  (ASetter
     (APIRequest supports [responseType])
     (APIRequest supports [responseType])
     (Maybe StatusId)
     (Maybe StatusId))
ASetter
  (APIRequest supports [responseType])
  (APIRequest supports [responseType])
  (Maybe StatusId)
  (Maybe StatusId)
#max_id ASetter
  (APIRequest supports [responseType])
  (APIRequest supports [responseType])
  (Maybe StatusId)
  (Maybe StatusId)
-> StatusId
-> APIRequest supports [responseType]
-> APIRequest supports [responseType]
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StatusId
mid StatusId -> StatusId -> StatusId
forall a. Num a => a -> a -> a
- StatusId
1
            Maybe StatusId
Nothing -> [Value] -> ConduitT () Value m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList [Value]
res

-- | A wrapper function to perform multiple API request with changing @cursor@ parameter.
--
-- This function cooperate with instances of 'HasCursorParam'.
sourceWithCursor ::
    ( MonadIO m
    , FromJSON responseType
    , KnownSymbol ck
    , HasParam "cursor" Integer supports
    ) =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest supports (WithCursor Integer ck responseType) ->
    C.ConduitT () responseType m ()
sourceWithCursor :: TWInfo
-> Manager
-> APIRequest supports (WithCursor StatusId ck responseType)
-> ConduitT () responseType m ()
sourceWithCursor TWInfo
info Manager
mgr APIRequest supports (WithCursor StatusId ck responseType)
req = Maybe StatusId -> ConduitT () responseType m ()
loop (StatusId -> Maybe StatusId
forall a. a -> Maybe a
Just (-StatusId
1))
  where
    loop :: Maybe StatusId -> ConduitT () responseType m ()
loop Maybe StatusId
Nothing = ConduitT () responseType m ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sourceNull
    loop (Just StatusId
0) = ConduitT () responseType m ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sourceNull
    loop (Just StatusId
cur) = do
        WithCursor StatusId ck responseType
res <- IO (WithCursor StatusId ck responseType)
-> ConduitT () responseType m (WithCursor StatusId ck responseType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WithCursor StatusId ck responseType)
 -> ConduitT
      () responseType m (WithCursor StatusId ck responseType))
-> IO (WithCursor StatusId ck responseType)
-> ConduitT () responseType m (WithCursor StatusId ck responseType)
forall a b. (a -> b) -> a -> b
$ TWInfo
-> Manager
-> APIRequest supports (WithCursor StatusId ck responseType)
-> IO (WithCursor StatusId ck responseType)
forall responseType (apiName :: [Param Symbol *]).
ResponseBodyType responseType =>
TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
call TWInfo
info Manager
mgr (APIRequest supports (WithCursor StatusId ck responseType)
 -> IO (WithCursor StatusId ck responseType))
-> APIRequest supports (WithCursor StatusId ck responseType)
-> IO (WithCursor StatusId ck responseType)
forall a b. (a -> b) -> a -> b
$ APIRequest supports (WithCursor StatusId ck responseType)
req APIRequest supports (WithCursor StatusId ck responseType)
-> (APIRequest supports (WithCursor StatusId ck responseType)
    -> APIRequest supports (WithCursor StatusId ck responseType))
-> APIRequest supports (WithCursor StatusId ck responseType)
forall a b. a -> (a -> b) -> b
& IsLabel
  "cursor"
  (ASetter
     (APIRequest supports (WithCursor StatusId ck responseType))
     (APIRequest supports (WithCursor StatusId ck responseType))
     (Maybe StatusId)
     (Maybe StatusId))
ASetter
  (APIRequest supports (WithCursor StatusId ck responseType))
  (APIRequest supports (WithCursor StatusId ck responseType))
  (Maybe StatusId)
  (Maybe StatusId)
#cursor ASetter
  (APIRequest supports (WithCursor StatusId ck responseType))
  (APIRequest supports (WithCursor StatusId ck responseType))
  (Maybe StatusId)
  (Maybe StatusId)
-> StatusId
-> APIRequest supports (WithCursor StatusId ck responseType)
-> APIRequest supports (WithCursor StatusId ck responseType)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StatusId
cur
        [responseType] -> ConduitT () responseType m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList ([responseType] -> ConduitT () responseType m ())
-> [responseType] -> ConduitT () responseType m ()
forall a b. (a -> b) -> a -> b
$ WithCursor StatusId ck responseType -> [responseType]
forall cursorType (cursorKey :: Symbol) wrapped.
WithCursor cursorType cursorKey wrapped -> [wrapped]
contents WithCursor StatusId ck responseType
res
        Maybe StatusId -> ConduitT () responseType m ()
loop (Maybe StatusId -> ConduitT () responseType m ())
-> Maybe StatusId -> ConduitT () responseType m ()
forall a b. (a -> b) -> a -> b
$ WithCursor StatusId ck responseType -> Maybe StatusId
forall cursorType (cursorKey :: Symbol) wrapped.
WithCursor cursorType cursorKey wrapped -> Maybe cursorType
nextCursor WithCursor StatusId ck responseType
res

-- | A wrapper function to perform multiple API request with changing @cursor@ parameter.
-- The response of this function is not restrict to @responseType@,
-- so you can choose an arbitrarily type of FromJSON instances.
--
-- This function cooperate with instances of 'HasCursorParam'.
sourceWithCursor' ::
    ( MonadIO m
    , KnownSymbol ck
    , HasParam "cursor" Integer supports
    ) =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest supports (WithCursor Integer ck responseType) ->
    C.ConduitT () Value m ()
sourceWithCursor' :: TWInfo
-> Manager
-> APIRequest supports (WithCursor StatusId ck responseType)
-> ConduitT () Value m ()
sourceWithCursor' TWInfo
info Manager
mgr APIRequest supports (WithCursor StatusId ck responseType)
req = Maybe StatusId -> ConduitT () Value m ()
loop (StatusId -> Maybe StatusId
forall a. a -> Maybe a
Just (-StatusId
1))
  where
    relax ::
        APIRequest apiName (WithCursor Integer ck responseType) ->
        APIRequest apiName (WithCursor Integer ck Value)
    relax :: APIRequest apiName (WithCursor StatusId ck responseType)
-> APIRequest apiName (WithCursor StatusId ck Value)
relax = APIRequest apiName (WithCursor StatusId ck responseType)
-> APIRequest apiName (WithCursor StatusId ck Value)
coerce
    loop :: Maybe StatusId -> ConduitT () Value m ()
loop Maybe StatusId
Nothing = ConduitT () Value m ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sourceNull
    loop (Just StatusId
0) = ConduitT () Value m ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sourceNull
    loop (Just StatusId
cur) = do
        WithCursor StatusId ck Value
res <- IO (WithCursor StatusId ck Value)
-> ConduitT () Value m (WithCursor StatusId ck Value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WithCursor StatusId ck Value)
 -> ConduitT () Value m (WithCursor StatusId ck Value))
-> IO (WithCursor StatusId ck Value)
-> ConduitT () Value m (WithCursor StatusId ck Value)
forall a b. (a -> b) -> a -> b
$ TWInfo
-> Manager
-> APIRequest supports (WithCursor StatusId ck Value)
-> IO (WithCursor StatusId ck Value)
forall responseType (apiName :: [Param Symbol *]).
ResponseBodyType responseType =>
TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
call TWInfo
info Manager
mgr (APIRequest supports (WithCursor StatusId ck Value)
 -> IO (WithCursor StatusId ck Value))
-> APIRequest supports (WithCursor StatusId ck Value)
-> IO (WithCursor StatusId ck Value)
forall a b. (a -> b) -> a -> b
$ APIRequest supports (WithCursor StatusId ck responseType)
-> APIRequest supports (WithCursor StatusId ck Value)
forall (apiName :: [Param Symbol *]) (ck :: Symbol) responseType.
APIRequest apiName (WithCursor StatusId ck responseType)
-> APIRequest apiName (WithCursor StatusId ck Value)
relax (APIRequest supports (WithCursor StatusId ck responseType)
 -> APIRequest supports (WithCursor StatusId ck Value))
-> APIRequest supports (WithCursor StatusId ck responseType)
-> APIRequest supports (WithCursor StatusId ck Value)
forall a b. (a -> b) -> a -> b
$ APIRequest supports (WithCursor StatusId ck responseType)
req APIRequest supports (WithCursor StatusId ck responseType)
-> (APIRequest supports (WithCursor StatusId ck responseType)
    -> APIRequest supports (WithCursor StatusId ck responseType))
-> APIRequest supports (WithCursor StatusId ck responseType)
forall a b. a -> (a -> b) -> b
& IsLabel
  "cursor"
  (ASetter
     (APIRequest supports (WithCursor StatusId ck responseType))
     (APIRequest supports (WithCursor StatusId ck responseType))
     (Maybe StatusId)
     (Maybe StatusId))
ASetter
  (APIRequest supports (WithCursor StatusId ck responseType))
  (APIRequest supports (WithCursor StatusId ck responseType))
  (Maybe StatusId)
  (Maybe StatusId)
#cursor ASetter
  (APIRequest supports (WithCursor StatusId ck responseType))
  (APIRequest supports (WithCursor StatusId ck responseType))
  (Maybe StatusId)
  (Maybe StatusId)
-> StatusId
-> APIRequest supports (WithCursor StatusId ck responseType)
-> APIRequest supports (WithCursor StatusId ck responseType)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StatusId
cur
        [Value] -> ConduitT () Value m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList ([Value] -> ConduitT () Value m ())
-> [Value] -> ConduitT () Value m ()
forall a b. (a -> b) -> a -> b
$ WithCursor StatusId ck Value -> [Value]
forall cursorType (cursorKey :: Symbol) wrapped.
WithCursor cursorType cursorKey wrapped -> [wrapped]
contents WithCursor StatusId ck Value
res
        Maybe StatusId -> ConduitT () Value m ()
loop (Maybe StatusId -> ConduitT () Value m ())
-> Maybe StatusId -> ConduitT () Value m ()
forall a b. (a -> b) -> a -> b
$ WithCursor StatusId ck Value -> Maybe StatusId
forall cursorType (cursorKey :: Symbol) wrapped.
WithCursor cursorType cursorKey wrapped -> Maybe cursorType
nextCursor WithCursor StatusId ck Value
res

-- | A wrapper function to perform multiple API request with @SearchResult@.
sourceWithSearchResult ::
    ( MonadIO m
    , FromJSON responseType
    ) =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest supports (SearchResult [responseType]) ->
    m (SearchResult (C.ConduitT () responseType m ()))
sourceWithSearchResult :: TWInfo
-> Manager
-> APIRequest supports (SearchResult [responseType])
-> m (SearchResult (ConduitT () responseType m ()))
sourceWithSearchResult TWInfo
info Manager
mgr APIRequest supports (SearchResult [responseType])
req = do
    SearchResult [responseType]
res <- IO (SearchResult [responseType]) -> m (SearchResult [responseType])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SearchResult [responseType])
 -> m (SearchResult [responseType]))
-> IO (SearchResult [responseType])
-> m (SearchResult [responseType])
forall a b. (a -> b) -> a -> b
$ TWInfo
-> Manager
-> APIRequest supports (SearchResult [responseType])
-> IO (SearchResult [responseType])
forall responseType (apiName :: [Param Symbol *]).
ResponseBodyType responseType =>
TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
call TWInfo
info Manager
mgr APIRequest supports (SearchResult [responseType])
req
    let body :: ConduitT () responseType m ()
body =
            [responseType] -> ConduitT () responseType m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (SearchResult [responseType]
res SearchResult [responseType]
-> Getting
     [responseType] (SearchResult [responseType]) [responseType]
-> [responseType]
forall s a. s -> Getting a s a -> a
^. Getting [responseType] (SearchResult [responseType]) [responseType]
forall body1 body2.
Lens (SearchResult body1) (SearchResult body2) body1 body2
searchResultStatuses)
                ConduitT () responseType m ()
-> ConduitT () responseType m () -> ConduitT () responseType m ()
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> ConduitT () responseType m ()
loop (SearchResult [responseType]
res SearchResult [responseType]
-> Getting (Maybe Text) (SearchResult [responseType]) (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. (SearchMetadata -> Const (Maybe Text) SearchMetadata)
-> SearchResult [responseType]
-> Const (Maybe Text) (SearchResult [responseType])
forall body. Lens' (SearchResult body) SearchMetadata
searchResultSearchMetadata ((SearchMetadata -> Const (Maybe Text) SearchMetadata)
 -> SearchResult [responseType]
 -> Const (Maybe Text) (SearchResult [responseType]))
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> SearchMetadata -> Const (Maybe Text) SearchMetadata)
-> Getting (Maybe Text) (SearchResult [responseType]) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> SearchMetadata -> Const (Maybe Text) SearchMetadata
Lens' SearchMetadata (Maybe Text)
searchMetadataNextResults)
    SearchResult (ConduitT () responseType m ())
-> m (SearchResult (ConduitT () responseType m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (SearchResult (ConduitT () responseType m ())
 -> m (SearchResult (ConduitT () responseType m ())))
-> SearchResult (ConduitT () responseType m ())
-> m (SearchResult (ConduitT () responseType m ()))
forall a b. (a -> b) -> a -> b
$ SearchResult [responseType]
res SearchResult [responseType]
-> (SearchResult [responseType]
    -> SearchResult (ConduitT () responseType m ()))
-> SearchResult (ConduitT () responseType m ())
forall a b. a -> (a -> b) -> b
& ([responseType] -> Identity (ConduitT () responseType m ()))
-> SearchResult [responseType]
-> Identity (SearchResult (ConduitT () responseType m ()))
forall body1 body2.
Lens (SearchResult body1) (SearchResult body2) body1 body2
searchResultStatuses (([responseType] -> Identity (ConduitT () responseType m ()))
 -> SearchResult [responseType]
 -> Identity (SearchResult (ConduitT () responseType m ())))
-> ConduitT () responseType m ()
-> SearchResult [responseType]
-> SearchResult (ConduitT () responseType m ())
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConduitT () responseType m ()
body
  where
    origQueryMap :: Map Method PV
origQueryMap = APIRequest supports (SearchResult [responseType])
req APIRequest supports (SearchResult [responseType])
-> Getting
     (Map Method PV)
     (APIRequest supports (SearchResult [responseType]))
     (Map Method PV)
-> Map Method PV
forall s a. s -> Getting a s a -> a
^. (APIQuery -> Const (Map Method PV) APIQuery)
-> APIRequest supports (SearchResult [responseType])
-> Const
     (Map Method PV) (APIRequest supports (SearchResult [responseType]))
forall req. Parameters req => Lens' req APIQuery
params ((APIQuery -> Const (Map Method PV) APIQuery)
 -> APIRequest supports (SearchResult [responseType])
 -> Const
      (Map Method PV)
      (APIRequest supports (SearchResult [responseType])))
-> ((Map Method PV -> Const (Map Method PV) (Map Method PV))
    -> APIQuery -> Const (Map Method PV) APIQuery)
-> Getting
     (Map Method PV)
     (APIRequest supports (SearchResult [responseType]))
     (Map Method PV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (APIQuery -> Map Method PV)
-> (Map Method PV -> Const (Map Method PV) (Map Method PV))
-> APIQuery
-> Const (Map Method PV) APIQuery
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to APIQuery -> Map Method PV
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    loop :: Maybe Text -> ConduitT () responseType m ()
loop Maybe Text
Nothing = ConduitT () responseType m ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sourceNull
    loop (Just Text
nextResultsStr) = do
        let nextResults :: APIQuery
nextResults = Text
nextResultsStr Text -> (Text -> SimpleQuery) -> SimpleQuery
forall a b. a -> (a -> b) -> b
& Method -> SimpleQuery
HT.parseSimpleQuery (Method -> SimpleQuery) -> (Text -> Method) -> Text -> SimpleQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Method
T.encodeUtf8 SimpleQuery -> (SimpleQuery -> APIQuery) -> APIQuery
forall a b. a -> (a -> b) -> b
& (SimpleQueryItem -> Identity (Method, PV))
-> SimpleQuery -> Identity APIQuery
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((SimpleQueryItem -> Identity (Method, PV))
 -> SimpleQuery -> Identity APIQuery)
-> ((Method -> Identity PV)
    -> SimpleQueryItem -> Identity (Method, PV))
-> (Method -> Identity PV)
-> SimpleQuery
-> Identity APIQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Method -> Identity PV) -> SimpleQueryItem -> Identity (Method, PV)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Method -> Identity PV) -> SimpleQuery -> Identity APIQuery)
-> (Method -> PV) -> SimpleQuery -> APIQuery
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> PV
PVString (Text -> PV) -> (Method -> Text) -> Method -> PV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text
T.decodeUtf8)
            nextParams :: APIQuery
nextParams = Map Method PV -> APIQuery
forall k a. Map k a -> [(k, a)]
M.toList (Map Method PV -> APIQuery) -> Map Method PV -> APIQuery
forall a b. (a -> b) -> a -> b
$ Map Method PV -> Map Method PV -> Map Method PV
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (APIQuery -> Map Method PV
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList APIQuery
nextResults) Map Method PV
origQueryMap
        SearchResult [responseType]
res <- IO (SearchResult [responseType])
-> ConduitT () responseType m (SearchResult [responseType])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SearchResult [responseType])
 -> ConduitT () responseType m (SearchResult [responseType]))
-> IO (SearchResult [responseType])
-> ConduitT () responseType m (SearchResult [responseType])
forall a b. (a -> b) -> a -> b
$ TWInfo
-> Manager
-> APIRequest supports (SearchResult [responseType])
-> IO (SearchResult [responseType])
forall responseType (apiName :: [Param Symbol *]).
ResponseBodyType responseType =>
TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
call TWInfo
info Manager
mgr (APIRequest supports (SearchResult [responseType])
 -> IO (SearchResult [responseType]))
-> APIRequest supports (SearchResult [responseType])
-> IO (SearchResult [responseType])
forall a b. (a -> b) -> a -> b
$ APIRequest supports (SearchResult [responseType])
req APIRequest supports (SearchResult [responseType])
-> (APIRequest supports (SearchResult [responseType])
    -> APIRequest supports (SearchResult [responseType]))
-> APIRequest supports (SearchResult [responseType])
forall a b. a -> (a -> b) -> b
& (APIQuery -> Identity APIQuery)
-> APIRequest supports (SearchResult [responseType])
-> Identity (APIRequest supports (SearchResult [responseType]))
forall req. Parameters req => Lens' req APIQuery
params ((APIQuery -> Identity APIQuery)
 -> APIRequest supports (SearchResult [responseType])
 -> Identity (APIRequest supports (SearchResult [responseType])))
-> APIQuery
-> APIRequest supports (SearchResult [responseType])
-> APIRequest supports (SearchResult [responseType])
forall s t a b. ASetter s t a b -> b -> s -> t
.~ APIQuery
nextParams
        [responseType] -> ConduitT () responseType m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (SearchResult [responseType]
res SearchResult [responseType]
-> Getting
     [responseType] (SearchResult [responseType]) [responseType]
-> [responseType]
forall s a. s -> Getting a s a -> a
^. Getting [responseType] (SearchResult [responseType]) [responseType]
forall body1 body2.
Lens (SearchResult body1) (SearchResult body2) body1 body2
searchResultStatuses)
        Maybe Text -> ConduitT () responseType m ()
loop (Maybe Text -> ConduitT () responseType m ())
-> Maybe Text -> ConduitT () responseType m ()
forall a b. (a -> b) -> a -> b
$ SearchResult [responseType]
res SearchResult [responseType]
-> Getting (Maybe Text) (SearchResult [responseType]) (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. (SearchMetadata -> Const (Maybe Text) SearchMetadata)
-> SearchResult [responseType]
-> Const (Maybe Text) (SearchResult [responseType])
forall body. Lens' (SearchResult body) SearchMetadata
searchResultSearchMetadata ((SearchMetadata -> Const (Maybe Text) SearchMetadata)
 -> SearchResult [responseType]
 -> Const (Maybe Text) (SearchResult [responseType]))
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> SearchMetadata -> Const (Maybe Text) SearchMetadata)
-> Getting (Maybe Text) (SearchResult [responseType]) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> SearchMetadata -> Const (Maybe Text) SearchMetadata
Lens' SearchMetadata (Maybe Text)
searchMetadataNextResults

-- | A wrapper function to perform multiple API request with @SearchResult@.
sourceWithSearchResult' ::
    ( MonadIO m
    ) =>
    -- | Twitter Setting
    TWInfo ->
    HTTP.Manager ->
    APIRequest supports (SearchResult [responseType]) ->
    m (SearchResult (C.ConduitT () Value m ()))
sourceWithSearchResult' :: TWInfo
-> Manager
-> APIRequest supports (SearchResult [responseType])
-> m (SearchResult (ConduitT () Value m ()))
sourceWithSearchResult' TWInfo
info Manager
mgr APIRequest supports (SearchResult [responseType])
req = do
    SearchResult [Value]
res <- IO (SearchResult [Value]) -> m (SearchResult [Value])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SearchResult [Value]) -> m (SearchResult [Value]))
-> IO (SearchResult [Value]) -> m (SearchResult [Value])
forall a b. (a -> b) -> a -> b
$ TWInfo
-> Manager
-> APIRequest supports (SearchResult [Value])
-> IO (SearchResult [Value])
forall responseType (apiName :: [Param Symbol *]).
ResponseBodyType responseType =>
TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
call TWInfo
info Manager
mgr (APIRequest supports (SearchResult [Value])
 -> IO (SearchResult [Value]))
-> APIRequest supports (SearchResult [Value])
-> IO (SearchResult [Value])
forall a b. (a -> b) -> a -> b
$ APIRequest supports (SearchResult [responseType])
-> APIRequest supports (SearchResult [Value])
forall (apiName :: [Param Symbol *]) responseType.
APIRequest apiName (SearchResult [responseType])
-> APIRequest apiName (SearchResult [Value])
relax APIRequest supports (SearchResult [responseType])
req
    let body :: ConduitT () Value m ()
body =
            [Value] -> ConduitT () Value m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (SearchResult [Value]
res SearchResult [Value]
-> Getting [Value] (SearchResult [Value]) [Value] -> [Value]
forall s a. s -> Getting a s a -> a
^. Getting [Value] (SearchResult [Value]) [Value]
forall body1 body2.
Lens (SearchResult body1) (SearchResult body2) body1 body2
searchResultStatuses)
                ConduitT () Value m ()
-> ConduitT () Value m () -> ConduitT () Value m ()
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> ConduitT () Value m ()
loop (SearchResult [Value]
res SearchResult [Value]
-> Getting (Maybe Text) (SearchResult [Value]) (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. (SearchMetadata -> Const (Maybe Text) SearchMetadata)
-> SearchResult [Value]
-> Const (Maybe Text) (SearchResult [Value])
forall body. Lens' (SearchResult body) SearchMetadata
searchResultSearchMetadata ((SearchMetadata -> Const (Maybe Text) SearchMetadata)
 -> SearchResult [Value]
 -> Const (Maybe Text) (SearchResult [Value]))
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> SearchMetadata -> Const (Maybe Text) SearchMetadata)
-> Getting (Maybe Text) (SearchResult [Value]) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> SearchMetadata -> Const (Maybe Text) SearchMetadata
Lens' SearchMetadata (Maybe Text)
searchMetadataNextResults)
    SearchResult (ConduitT () Value m ())
-> m (SearchResult (ConduitT () Value m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (SearchResult (ConduitT () Value m ())
 -> m (SearchResult (ConduitT () Value m ())))
-> SearchResult (ConduitT () Value m ())
-> m (SearchResult (ConduitT () Value m ()))
forall a b. (a -> b) -> a -> b
$ SearchResult [Value]
res SearchResult [Value]
-> (SearchResult [Value] -> SearchResult (ConduitT () Value m ()))
-> SearchResult (ConduitT () Value m ())
forall a b. a -> (a -> b) -> b
& ([Value] -> Identity (ConduitT () Value m ()))
-> SearchResult [Value]
-> Identity (SearchResult (ConduitT () Value m ()))
forall body1 body2.
Lens (SearchResult body1) (SearchResult body2) body1 body2
searchResultStatuses (([Value] -> Identity (ConduitT () Value m ()))
 -> SearchResult [Value]
 -> Identity (SearchResult (ConduitT () Value m ())))
-> ConduitT () Value m ()
-> SearchResult [Value]
-> SearchResult (ConduitT () Value m ())
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConduitT () Value m ()
body
  where
    origQueryMap :: Map Method PV
origQueryMap = APIRequest supports (SearchResult [responseType])
req APIRequest supports (SearchResult [responseType])
-> Getting
     (Map Method PV)
     (APIRequest supports (SearchResult [responseType]))
     (Map Method PV)
-> Map Method PV
forall s a. s -> Getting a s a -> a
^. (APIQuery -> Const (Map Method PV) APIQuery)
-> APIRequest supports (SearchResult [responseType])
-> Const
     (Map Method PV) (APIRequest supports (SearchResult [responseType]))
forall req. Parameters req => Lens' req APIQuery
params ((APIQuery -> Const (Map Method PV) APIQuery)
 -> APIRequest supports (SearchResult [responseType])
 -> Const
      (Map Method PV)
      (APIRequest supports (SearchResult [responseType])))
-> ((Map Method PV -> Const (Map Method PV) (Map Method PV))
    -> APIQuery -> Const (Map Method PV) APIQuery)
-> Getting
     (Map Method PV)
     (APIRequest supports (SearchResult [responseType]))
     (Map Method PV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (APIQuery -> Map Method PV)
-> (Map Method PV -> Const (Map Method PV) (Map Method PV))
-> APIQuery
-> Const (Map Method PV) APIQuery
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to APIQuery -> Map Method PV
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    relax ::
        APIRequest apiName (SearchResult [responseType]) ->
        APIRequest apiName (SearchResult [Value])
    relax :: APIRequest apiName (SearchResult [responseType])
-> APIRequest apiName (SearchResult [Value])
relax = APIRequest apiName (SearchResult [responseType])
-> APIRequest apiName (SearchResult [Value])
coerce
    loop :: Maybe Text -> ConduitT () Value m ()
loop Maybe Text
Nothing = ConduitT () Value m ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sourceNull
    loop (Just Text
nextResultsStr) = do
        let nextResults :: APIQuery
nextResults = Text
nextResultsStr Text -> (Text -> SimpleQuery) -> SimpleQuery
forall a b. a -> (a -> b) -> b
& Method -> SimpleQuery
HT.parseSimpleQuery (Method -> SimpleQuery) -> (Text -> Method) -> Text -> SimpleQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Method
T.encodeUtf8 SimpleQuery -> (SimpleQuery -> APIQuery) -> APIQuery
forall a b. a -> (a -> b) -> b
& (SimpleQueryItem -> Identity (Method, PV))
-> SimpleQuery -> Identity APIQuery
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((SimpleQueryItem -> Identity (Method, PV))
 -> SimpleQuery -> Identity APIQuery)
-> ((Method -> Identity PV)
    -> SimpleQueryItem -> Identity (Method, PV))
-> (Method -> Identity PV)
-> SimpleQuery
-> Identity APIQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Method -> Identity PV) -> SimpleQueryItem -> Identity (Method, PV)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Method -> Identity PV) -> SimpleQuery -> Identity APIQuery)
-> (Method -> PV) -> SimpleQuery -> APIQuery
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> PV
PVString (Text -> PV) -> (Method -> Text) -> Method -> PV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text
T.decodeUtf8)
            nextParams :: APIQuery
nextParams = Map Method PV -> APIQuery
forall k a. Map k a -> [(k, a)]
M.toList (Map Method PV -> APIQuery) -> Map Method PV -> APIQuery
forall a b. (a -> b) -> a -> b
$ Map Method PV -> Map Method PV -> Map Method PV
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (APIQuery -> Map Method PV
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList APIQuery
nextResults) Map Method PV
origQueryMap
        SearchResult [Value]
res <- IO (SearchResult [Value])
-> ConduitT () Value m (SearchResult [Value])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SearchResult [Value])
 -> ConduitT () Value m (SearchResult [Value]))
-> IO (SearchResult [Value])
-> ConduitT () Value m (SearchResult [Value])
forall a b. (a -> b) -> a -> b
$ TWInfo
-> Manager
-> APIRequest supports (SearchResult [Value])
-> IO (SearchResult [Value])
forall responseType (apiName :: [Param Symbol *]).
ResponseBodyType responseType =>
TWInfo
-> Manager -> APIRequest apiName responseType -> IO responseType
call TWInfo
info Manager
mgr (APIRequest supports (SearchResult [Value])
 -> IO (SearchResult [Value]))
-> APIRequest supports (SearchResult [Value])
-> IO (SearchResult [Value])
forall a b. (a -> b) -> a -> b
$ APIRequest supports (SearchResult [responseType])
-> APIRequest supports (SearchResult [Value])
forall (apiName :: [Param Symbol *]) responseType.
APIRequest apiName (SearchResult [responseType])
-> APIRequest apiName (SearchResult [Value])
relax (APIRequest supports (SearchResult [responseType])
 -> APIRequest supports (SearchResult [Value]))
-> APIRequest supports (SearchResult [responseType])
-> APIRequest supports (SearchResult [Value])
forall a b. (a -> b) -> a -> b
$ APIRequest supports (SearchResult [responseType])
req APIRequest supports (SearchResult [responseType])
-> (APIRequest supports (SearchResult [responseType])
    -> APIRequest supports (SearchResult [responseType]))
-> APIRequest supports (SearchResult [responseType])
forall a b. a -> (a -> b) -> b
& (APIQuery -> Identity APIQuery)
-> APIRequest supports (SearchResult [responseType])
-> Identity (APIRequest supports (SearchResult [responseType]))
forall req. Parameters req => Lens' req APIQuery
params ((APIQuery -> Identity APIQuery)
 -> APIRequest supports (SearchResult [responseType])
 -> Identity (APIRequest supports (SearchResult [responseType])))
-> APIQuery
-> APIRequest supports (SearchResult [responseType])
-> APIRequest supports (SearchResult [responseType])
forall s t a b. ASetter s t a b -> b -> s -> t
.~ APIQuery
nextParams
        [Value] -> ConduitT () Value m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (SearchResult [Value]
res SearchResult [Value]
-> Getting [Value] (SearchResult [Value]) [Value] -> [Value]
forall s a. s -> Getting a s a -> a
^. Getting [Value] (SearchResult [Value]) [Value]
forall body1 body2.
Lens (SearchResult body1) (SearchResult body2) body1 body2
searchResultStatuses)
        Maybe Text -> ConduitT () Value m ()
loop (Maybe Text -> ConduitT () Value m ())
-> Maybe Text -> ConduitT () Value m ()
forall a b. (a -> b) -> a -> b
$ SearchResult [Value]
res SearchResult [Value]
-> Getting (Maybe Text) (SearchResult [Value]) (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. (SearchMetadata -> Const (Maybe Text) SearchMetadata)
-> SearchResult [Value]
-> Const (Maybe Text) (SearchResult [Value])
forall body. Lens' (SearchResult body) SearchMetadata
searchResultSearchMetadata ((SearchMetadata -> Const (Maybe Text) SearchMetadata)
 -> SearchResult [Value]
 -> Const (Maybe Text) (SearchResult [Value]))
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> SearchMetadata -> Const (Maybe Text) SearchMetadata)
-> Getting (Maybe Text) (SearchResult [Value]) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> SearchMetadata -> Const (Maybe Text) SearchMetadata
Lens' SearchMetadata (Maybe Text)
searchMetadataNextResults

sinkJSON ::
    ( MonadThrow m
    ) =>
    C.ConduitT ByteString o m Value
sinkJSON :: ConduitT Method o m Value
sinkJSON = Parser Method Value -> ConduitT Method o m Value
forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
CA.sinkParser Parser Method Value
json

sinkFromJSON ::
    ( FromJSON a
    , MonadThrow m
    ) =>
    C.ConduitT ByteString o m a
sinkFromJSON :: ConduitT Method o m a
sinkFromJSON = do
    Value
v <- ConduitT Method o m Value
forall (m :: * -> *) o. MonadThrow m => ConduitT Method o m Value
sinkJSON
    case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
        Error String
err -> TwitterError -> ConduitT Method o m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TwitterError -> ConduitT Method o m a)
-> TwitterError -> ConduitT Method o m a
forall a b. (a -> b) -> a -> b
$ String -> TwitterError
FromJSONError String
err
        Success a
r -> a -> ConduitT Method o m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r