{-# LANGUAGE RankNTypes #-}

module Web.Twitter.Conduit.Lens (
    -- * 'TT.Response'
    TT.Response,
    responseStatus,
    responseBody,
    responseHeaders,

    -- * 'TT.TwitterErrorMessage'
    TT.TwitterErrorMessage,
    twitterErrorMessage,
    twitterErrorCode,

    -- * 'TT.WithCursor'
    TT.WithCursor,
    previousCursor,
    nextCursor,
    contents,

    -- * Re-exports
    TT.TwitterError (..),
) where

import Control.Lens
import Data.Text (Text)
import Network.HTTP.Types (ResponseHeaders, Status)
import qualified Web.Twitter.Conduit.Cursor as TT
import qualified Web.Twitter.Conduit.Response as TT

-- * Lenses for 'TT.Response'
responseStatus :: forall responseType. Lens' (TT.Response responseType) Status
responseStatus :: (Status -> f Status)
-> Response responseType -> f (Response responseType)
responseStatus Status -> f Status
afb Response responseType
s = (\Status
b -> Response responseType
s {responseStatus :: Status
TT.responseStatus = Status
b}) (Status -> Response responseType)
-> f Status -> f (Response responseType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> f Status
afb (Response responseType -> Status
forall responseType. Response responseType -> Status
TT.responseStatus Response responseType
s)

responseHeaders :: forall responseType. Lens' (TT.Response responseType) ResponseHeaders
responseHeaders :: (ResponseHeaders -> f ResponseHeaders)
-> Response responseType -> f (Response responseType)
responseHeaders ResponseHeaders -> f ResponseHeaders
afb Response responseType
s = (\ResponseHeaders
b -> Response responseType
s {responseHeaders :: ResponseHeaders
TT.responseHeaders = ResponseHeaders
b}) (ResponseHeaders -> Response responseType)
-> f ResponseHeaders -> f (Response responseType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponseHeaders -> f ResponseHeaders
afb (Response responseType -> ResponseHeaders
forall responseType. Response responseType -> ResponseHeaders
TT.responseHeaders Response responseType
s)

responseBody :: forall a b. Lens (TT.Response a) (TT.Response b) a b
responseBody :: (a -> f b) -> Response a -> f (Response b)
responseBody a -> f b
afb Response a
s = (\b
b -> Response a
s {responseBody :: b
TT.responseBody = b
b}) (b -> Response b) -> f b -> f (Response b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb (Response a -> a
forall responseType. Response responseType -> responseType
TT.responseBody Response a
s)
-- * Lenses for 'TT.TwitterErrorMessage'

twitterErrorCode :: Lens' TT.TwitterErrorMessage Int
twitterErrorCode :: (Int -> f Int) -> TwitterErrorMessage -> f TwitterErrorMessage
twitterErrorCode Int -> f Int
afb TwitterErrorMessage
s = (\Int
b -> TwitterErrorMessage
s {twitterErrorCode :: Int
TT.twitterErrorCode = Int
b}) (Int -> TwitterErrorMessage) -> f Int -> f TwitterErrorMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
afb (TwitterErrorMessage -> Int
TT.twitterErrorCode TwitterErrorMessage
s)

twitterErrorMessage :: Lens' TT.TwitterErrorMessage Text
twitterErrorMessage :: (Text -> f Text) -> TwitterErrorMessage -> f TwitterErrorMessage
twitterErrorMessage Text -> f Text
afb TwitterErrorMessage
s = (\Text
b -> TwitterErrorMessage
s {twitterErrorMessage :: Text
TT.twitterErrorMessage = Text
b}) (Text -> TwitterErrorMessage) -> f Text -> f TwitterErrorMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
afb (TwitterErrorMessage -> Text
TT.twitterErrorMessage TwitterErrorMessage
s)
-- * Lenses for 'TT.WithCursor'
previousCursor :: forall cursorType cursorKey wrapped. Lens' (TT.WithCursor cursorType cursorKey wrapped) (Maybe cursorType)
previousCursor :: (Maybe cursorType -> f (Maybe cursorType))
-> WithCursor cursorType cursorKey wrapped
-> f (WithCursor cursorType cursorKey wrapped)
previousCursor Maybe cursorType -> f (Maybe cursorType)
afb WithCursor cursorType cursorKey wrapped
s = (\Maybe cursorType
b -> WithCursor cursorType cursorKey wrapped
s {previousCursor :: Maybe cursorType
TT.previousCursor = Maybe cursorType
b}) (Maybe cursorType -> WithCursor cursorType cursorKey wrapped)
-> f (Maybe cursorType)
-> f (WithCursor cursorType cursorKey wrapped)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe cursorType -> f (Maybe cursorType)
afb (WithCursor cursorType cursorKey wrapped -> Maybe cursorType
forall cursorType (cursorKey :: Symbol) wrapped.
WithCursor cursorType cursorKey wrapped -> Maybe cursorType
TT.previousCursor WithCursor cursorType cursorKey wrapped
s)

nextCursor :: forall cursorType cursorKey wrapped. Lens' (TT.WithCursor cursorType cursorKey wrapped) (Maybe cursorType)
nextCursor :: (Maybe cursorType -> f (Maybe cursorType))
-> WithCursor cursorType cursorKey wrapped
-> f (WithCursor cursorType cursorKey wrapped)
nextCursor Maybe cursorType -> f (Maybe cursorType)
afb WithCursor cursorType cursorKey wrapped
s = (\Maybe cursorType
b -> WithCursor cursorType cursorKey wrapped
s {nextCursor :: Maybe cursorType
TT.nextCursor = Maybe cursorType
b}) (Maybe cursorType -> WithCursor cursorType cursorKey wrapped)
-> f (Maybe cursorType)
-> f (WithCursor cursorType cursorKey wrapped)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe cursorType -> f (Maybe cursorType)
afb (WithCursor cursorType cursorKey wrapped -> Maybe cursorType
forall cursorType (cursorKey :: Symbol) wrapped.
WithCursor cursorType cursorKey wrapped -> Maybe cursorType
TT.nextCursor WithCursor cursorType cursorKey wrapped
s)

contents :: forall cursorType cursorKey a b. Lens (TT.WithCursor cursorType cursorKey a) (TT.WithCursor cursorType cursorKey b) [a] [b]
contents :: ([a] -> f [b])
-> WithCursor cursorType cursorKey a
-> f (WithCursor cursorType cursorKey b)
contents [a] -> f [b]
afb WithCursor cursorType cursorKey a
s = (\[b]
b -> WithCursor cursorType cursorKey a
s {contents :: [b]
TT.contents = [b]
b}) ([b] -> WithCursor cursorType cursorKey b)
-> f [b] -> f (WithCursor cursorType cursorKey b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
afb (WithCursor cursorType cursorKey a -> [a]
forall cursorType (cursorKey :: Symbol) wrapped.
WithCursor cursorType cursorKey wrapped -> [wrapped]
TT.contents WithCursor cursorType cursorKey a
s)