{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}

module Web.Twitter.Types.Lens (
    -- * Type classes
    AsStatus (..),
    AsUser (..),
    HasCreatedAt (..),
    AsImageSize (..),

    -- * 'TT.Status'
    TT.Status,
    statusContributors,
    statusCoordinates,
    statusCreatedAt,
    statusCurrentUserRetweet,
    statusEntities,
    statusExtendedEntities,
    statusFavoriteCount,
    statusFavorited,
    statusFilterLevel,
    statusId,
    statusInReplyToScreenName,
    statusInReplyToStatusId,
    statusInReplyToUserId,
    statusLang,
    statusPlace,
    statusPossiblySensitive,
    statusScopes,
    statusQuotedStatusId,
    statusQuotedStatus,
    statusRetweetCount,
    statusRetweeted,
    statusRetweetedStatus,
    statusSource,
    statusText,
    statusTruncated,
    statusUser,
    statusWithheldCopyright,
    statusWithheldInCountries,
    statusWithheldScope,
    statusDisplayTextRange,

    -- * 'TT.SearchResult'
    TT.SearchResult,
    searchResultStatuses,
    searchResultSearchMetadata,

    -- * 'TT.SearchStatus'
    TT.SearchStatus,
    searchStatusCreatedAt,
    searchStatusId,
    searchStatusText,
    searchStatusSource,
    searchStatusUser,
    searchStatusCoordinates,

    -- * 'TT.SearchMetadata'
    TT.SearchMetadata,
    searchMetadataMaxId,
    searchMetadataSinceId,
    searchMetadataRefreshURL,
    searchMetadataNextResults,
    searchMetadataCount,
    searchMetadataCompletedIn,
    searchMetadataSinceIdStr,
    searchMetadataQuery,
    searchMetadataMaxIdStr,

    -- * 'TT.RetweetedStatus'
    TT.RetweetedStatus,
    rsCreatedAt,
    rsId,
    rsText,
    rsSource,
    rsTruncated,
    rsEntities,
    rsUser,
    rsRetweetedStatus,
    rsCoordinates,

    -- * 'TT.DirectMessage'
    TT.DirectMessage,
    dmId,
    dmCreatedTimestamp,
    dmTargetRecipientId,
    dmSenderId,
    dmText,
    dmEntities,

    -- * 'TT.Event'
    TT.Event,
    evCreatedAt,
    evTargetObject,
    evEvent,
    evTarget,
    evSource,

    -- * 'TT.Delete'
    TT.Delete,
    delId,
    delUserId,

    -- * 'TT.User'
    TT.User,
    userContributorsEnabled,
    userCreatedAt,
    userDefaultProfile,
    userDefaultProfileImage,
    userEmail,
    userDescription,
    userFavoritesCount,
    userFollowRequestSent,
    userFollowing,
    userFollowersCount,
    userFriendsCount,
    userGeoEnabled,
    userId,
    userIsTranslator,
    userLang,
    userListedCount,
    userLocation,
    userName,
    userNotifications,
    userProfileBackgroundColor,
    userProfileBackgroundImageURL,
    userProfileBackgroundImageURLHttps,
    userProfileBackgroundTile,
    userProfileBannerURL,
    userProfileImageURL,
    userProfileImageURLHttps,
    userProfileLinkColor,
    userProfileSidebarBorderColor,
    userProfileSidebarFillColor,
    userProfileTextColor,
    userProfileUseBackgroundImage,
    userProtected,
    userScreenName,
    userShowAllInlineMedia,
    userStatusesCount,
    userTimeZone,
    userURL,
    userUtcOffset,
    userVerified,
    userWithheldInCountries,
    userWithheldScope,

    -- * 'TT.List'
    TT.List,
    listId,
    listName,
    listFullName,
    listMemberCount,
    listSubscriberCount,
    listMode,
    listUser,

    -- * 'TT.Entities'
    TT.Entities,
    enHashTags,
    enUserMentions,
    enURLs,
    enMedia,

    -- * 'TT.ExtendedEntities'
    TT.ExtendedEntities,
    exeMedia,

    -- * 'TT.ExtendedEntity'
    TT.ExtendedEntity,
    exeID,
    exeMediaUrl,
    exeMediaUrlHttps,
    exeURL,
    exeSizes,
    exeType,
    exeVideoInfo,
    exeDurationMillis,
    exeExtAltText,

    -- * 'TT.Entity'
    TT.Entity,
    entityBody,
    entityIndices,

    -- * 'TT.HashTagEntity'
    TT.HashTagEntity,
    hashTagText,

    -- * 'TT.UserEntity'
    TT.UserEntity,
    userEntityUserId,
    userEntityUserName,
    userEntityUserScreenName,

    -- * 'TT.URLEntity'
    TT.URLEntity,
    ueURL,
    ueExpanded,
    ueDisplay,

    -- * 'TT.MediaEntity'
    TT.MediaEntity,
    meType,
    meId,
    meSizes,
    meMediaURL,
    meMediaURLHttps,
    meURL,

    -- * 'TT.MediaSize'
    TT.MediaSize,
    msWidth,
    msHeight,
    msResize,

    -- * 'TT.Coordinates'
    TT.Coordinates,
    coordinates,
    coordinatesType,

    -- * 'TT.Place'
    TT.Place,
    placeAttributes,
    placeBoundingBox,
    placeCountry,
    placeCountryCode,
    placeFullName,
    placeId,
    placeName,
    placeType,
    placeURL,

    -- * 'TT.BoundingBox'
    TT.BoundingBox,
    boundingBoxCoordinates,
    boundingBoxType,

    -- * 'TT.Contributor'
    TT.Contributor,
    contributorId,
    contributorScreenName,

    -- * 'TT.UploadedMedia'
    TT.UploadedMedia,
    uploadedMediaId,
    uploadedMediaSize,
    uploadedMediaImage,

    -- * 'TT.ImageSizeType'
    TT.ImageSizeType,
    imageSizeTypeWidth,
    imageSizeTypeHeight,
    imageSizeTypeType,
    TT.DisplayTextRange,
    displayTextRangeStart,
    displayTextRangeEnd,

    -- * Type aliases and sum types
    TT.UserId,
    TT.Friends,
    TT.URIString,
    TT.UserName,
    TT.StatusId,
    TT.LanguageCode,
    TT.StreamingAPI (..),
    TT.EventTarget (..),
    TT.EntityIndices,

    -- * 'TT.StreamingAPI'
    _SStatus,
    _SRetweetedStatus,
    _SEvent,
    _SDelete,
    _SFriends,
    _SDirectMessage,
    _SUnknown,

    -- * 'TT.EventTarget'
    _ETUser,
    _ETStatus,
    _ETList,
    _ETUnknown,
) where

import Control.Lens hiding (makeLenses)
import Data.Text (Text)
import Data.Time
import qualified Web.Twitter.Types as TT
import Web.Twitter.Types.Lens.TH

makeLenses ''TT.Status
makeLenses ''TT.SearchResult
makeLenses ''TT.SearchStatus
makeLenses ''TT.SearchMetadata
makeLenses ''TT.RetweetedStatus
makeLenses ''TT.DirectMessage
makeLenses ''TT.Event
makeLenses ''TT.Delete
makeLenses ''TT.User
makeLenses ''TT.List
makeLenses ''TT.Entities
makeLenses ''TT.ExtendedEntities
makeLenses ''TT.ExtendedEntity
makeLenses ''TT.Entity
makeLenses ''TT.HashTagEntity
makeLenses ''TT.UserEntity
makeLenses ''TT.URLEntity
makeLenses ''TT.MediaEntity
makeLenses ''TT.MediaSize
makeLenses ''TT.Coordinates
makeLenses ''TT.Place
makeLenses ''TT.BoundingBox
makeLenses ''TT.Contributor
makeLenses ''TT.ImageSizeType
makeLenses ''TT.UploadedMedia
makeLenses ''TT.DisplayTextRange

class AsStatus s where
    status_id :: Lens' s TT.StatusId
    text :: Lens' s Text
    user :: Lens' s TT.User
    geolocation :: Lens' s (Maybe TT.Coordinates)

instance AsStatus TT.Status where
    status_id :: (Integer -> f Integer) -> Status -> f Status
status_id = (Integer -> f Integer) -> Status -> f Status
Lens' Status Integer
statusId
    text :: (Text -> f Text) -> Status -> f Status
text = (Text -> f Text) -> Status -> f Status
Lens' Status Text
statusText
    user :: (User -> f User) -> Status -> f Status
user = (User -> f User) -> Status -> f Status
Lens' Status User
statusUser
    geolocation :: (Maybe Coordinates -> f (Maybe Coordinates)) -> Status -> f Status
geolocation = (Maybe Coordinates -> f (Maybe Coordinates)) -> Status -> f Status
Lens' Status (Maybe Coordinates)
statusCoordinates

instance AsStatus TT.SearchStatus where
    status_id :: (Integer -> f Integer) -> SearchStatus -> f SearchStatus
status_id = (Integer -> f Integer) -> SearchStatus -> f SearchStatus
Lens' SearchStatus Integer
searchStatusId
    text :: (Text -> f Text) -> SearchStatus -> f SearchStatus
text = (Text -> f Text) -> SearchStatus -> f SearchStatus
Lens' SearchStatus Text
searchStatusText
    user :: (User -> f User) -> SearchStatus -> f SearchStatus
user = (User -> f User) -> SearchStatus -> f SearchStatus
Lens' SearchStatus User
searchStatusUser
    geolocation :: (Maybe Coordinates -> f (Maybe Coordinates))
-> SearchStatus -> f SearchStatus
geolocation = (Maybe Coordinates -> f (Maybe Coordinates))
-> SearchStatus -> f SearchStatus
Lens' SearchStatus (Maybe Coordinates)
searchStatusCoordinates

instance AsStatus TT.RetweetedStatus where
    status_id :: (Integer -> f Integer) -> RetweetedStatus -> f RetweetedStatus
status_id = (Integer -> f Integer) -> RetweetedStatus -> f RetweetedStatus
Lens' RetweetedStatus Integer
rsId
    text :: (Text -> f Text) -> RetweetedStatus -> f RetweetedStatus
text = (Text -> f Text) -> RetweetedStatus -> f RetweetedStatus
Lens' RetweetedStatus Text
rsText
    user :: (User -> f User) -> RetweetedStatus -> f RetweetedStatus
user = (User -> f User) -> RetweetedStatus -> f RetweetedStatus
Lens' RetweetedStatus User
rsUser
    geolocation :: (Maybe Coordinates -> f (Maybe Coordinates))
-> RetweetedStatus -> f RetweetedStatus
geolocation = (Maybe Coordinates -> f (Maybe Coordinates))
-> RetweetedStatus -> f RetweetedStatus
Lens' RetweetedStatus (Maybe Coordinates)
rsCoordinates

class AsUser u where
    user_id :: Lens' u TT.UserId
    name :: Lens' u TT.UserName
    screen_name :: Lens' u Text

instance AsUser TT.User where
    user_id :: (Integer -> f Integer) -> User -> f User
user_id = (Integer -> f Integer) -> User -> f User
Lens' User Integer
userId
    name :: (Text -> f Text) -> User -> f User
name = (Text -> f Text) -> User -> f User
Lens' User Text
userName
    screen_name :: (Text -> f Text) -> User -> f User
screen_name = (Text -> f Text) -> User -> f User
Lens' User Text
userScreenName

instance AsUser TT.UserEntity where
    user_id :: (Integer -> f Integer) -> UserEntity -> f UserEntity
user_id = (Integer -> f Integer) -> UserEntity -> f UserEntity
Lens' UserEntity Integer
userEntityUserId
    name :: (Text -> f Text) -> UserEntity -> f UserEntity
name = (Text -> f Text) -> UserEntity -> f UserEntity
Lens' UserEntity Text
userEntityUserName
    screen_name :: (Text -> f Text) -> UserEntity -> f UserEntity
screen_name = (Text -> f Text) -> UserEntity -> f UserEntity
Lens' UserEntity Text
userEntityUserScreenName

instance AsUser (TT.Entity TT.UserEntity) where
    user_id :: (Integer -> f Integer)
-> Entity UserEntity -> f (Entity UserEntity)
user_id = (UserEntity -> f UserEntity)
-> Entity UserEntity -> f (Entity UserEntity)
forall a a. Lens (Entity a) (Entity a) a a
entityBody ((UserEntity -> f UserEntity)
 -> Entity UserEntity -> f (Entity UserEntity))
-> ((Integer -> f Integer) -> UserEntity -> f UserEntity)
-> (Integer -> f Integer)
-> Entity UserEntity
-> f (Entity UserEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> f Integer) -> UserEntity -> f UserEntity
Lens' UserEntity Integer
userEntityUserId
    name :: (Text -> f Text) -> Entity UserEntity -> f (Entity UserEntity)
name = (UserEntity -> f UserEntity)
-> Entity UserEntity -> f (Entity UserEntity)
forall a a. Lens (Entity a) (Entity a) a a
entityBody ((UserEntity -> f UserEntity)
 -> Entity UserEntity -> f (Entity UserEntity))
-> ((Text -> f Text) -> UserEntity -> f UserEntity)
-> (Text -> f Text)
-> Entity UserEntity
-> f (Entity UserEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> UserEntity -> f UserEntity
Lens' UserEntity Text
userEntityUserName
    screen_name :: (Text -> f Text) -> Entity UserEntity -> f (Entity UserEntity)
screen_name = (UserEntity -> f UserEntity)
-> Entity UserEntity -> f (Entity UserEntity)
forall a a. Lens (Entity a) (Entity a) a a
entityBody ((UserEntity -> f UserEntity)
 -> Entity UserEntity -> f (Entity UserEntity))
-> ((Text -> f Text) -> UserEntity -> f UserEntity)
-> (Text -> f Text)
-> Entity UserEntity
-> f (Entity UserEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> UserEntity -> f UserEntity
Lens' UserEntity Text
userEntityUserScreenName

class HasCreatedAt a where
    created_at :: Lens' a UTCTime
instance HasCreatedAt TT.Status where
    created_at :: (UTCTime -> f UTCTime) -> Status -> f Status
created_at = (UTCTime -> f UTCTime) -> Status -> f Status
Lens' Status UTCTime
statusCreatedAt
instance HasCreatedAt TT.SearchStatus where
    created_at :: (UTCTime -> f UTCTime) -> SearchStatus -> f SearchStatus
created_at = (UTCTime -> f UTCTime) -> SearchStatus -> f SearchStatus
Lens' SearchStatus UTCTime
searchStatusCreatedAt
instance HasCreatedAt TT.RetweetedStatus where
    created_at :: (UTCTime -> f UTCTime) -> RetweetedStatus -> f RetweetedStatus
created_at = (UTCTime -> f UTCTime) -> RetweetedStatus -> f RetweetedStatus
Lens' RetweetedStatus UTCTime
rsCreatedAt
instance HasCreatedAt TT.DirectMessage where
    created_at :: (UTCTime -> f UTCTime) -> DirectMessage -> f DirectMessage
created_at = (UTCTime -> f UTCTime) -> DirectMessage -> f DirectMessage
Lens' DirectMessage UTCTime
dmCreatedTimestamp
instance HasCreatedAt TT.User where
    created_at :: (UTCTime -> f UTCTime) -> User -> f User
created_at = (UTCTime -> f UTCTime) -> User -> f User
Lens' User UTCTime
userCreatedAt

class AsImageSize a where
    width :: Lens' a Int
    height :: Lens' a Int
instance AsImageSize TT.MediaSize where
    width :: (Int -> f Int) -> MediaSize -> f MediaSize
width = (Int -> f Int) -> MediaSize -> f MediaSize
Lens' MediaSize Int
msWidth
    height :: (Int -> f Int) -> MediaSize -> f MediaSize
height = (Int -> f Int) -> MediaSize -> f MediaSize
Lens' MediaSize Int
msHeight
instance AsImageSize TT.ImageSizeType where
    width :: (Int -> f Int) -> ImageSizeType -> f ImageSizeType
width = (Int -> f Int) -> ImageSizeType -> f ImageSizeType
Lens' ImageSizeType Int
imageSizeTypeWidth
    height :: (Int -> f Int) -> ImageSizeType -> f ImageSizeType
height = (Int -> f Int) -> ImageSizeType -> f ImageSizeType
Lens' ImageSizeType Int
imageSizeTypeHeight

makePrisms ''TT.StreamingAPI
makePrisms ''TT.EventTarget