twitter-types-0.7.2.2/Web/0000755000000000000000000000000012730546400013430 5ustar0000000000000000twitter-types-0.7.2.2/Web/Twitter/0000755000000000000000000000000012730546400015072 5ustar0000000000000000twitter-types-0.7.2.2/tests/0000755000000000000000000000000012730546400014055 5ustar0000000000000000twitter-types-0.7.2.2/tests/fixtures/0000755000000000000000000000000012730546400015726 5ustar0000000000000000twitter-types-0.7.2.2/Web/Twitter/Types.hs0000644000000000000000000011417412730546400016542 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, RecordWildCards, DeriveGeneric, CPP #-} module Web.Twitter.Types ( UserId , Friends , URIString , UserName , StatusId , LanguageCode , StreamingAPI(..) , Status(..) , SearchResult(..) , SearchStatus(..) , SearchMetadata(..) , RetweetedStatus(..) , DirectMessage(..) , EventTarget(..) , Event(..) , Delete(..) , User(..) , List(..) , Entities(..) , EntityIndices , Entity(..) , HashTagEntity(..) , UserEntity(..) , URLEntity(..) , MediaEntity(..) , MediaSize(..) , Coordinates(..) , Place(..) , BoundingBox(..) , Contributor(..) , UploadedMedia (..) , ImageSizeType (..) , checkError , twitterTimeFormat ) where import Control.Applicative import Data.Aeson import Data.Aeson.Types (Parser) import Data.Data import Data.HashMap.Strict (HashMap, fromList, union) import Data.Text (Text, unpack, pack) import GHC.Generics #if MIN_VERSION_time(1, 5, 0) import Data.Time #else import Data.Time import System.Locale #endif newtype TwitterTime = TwitterTime { fromTwitterTime :: UTCTime } type UserId = Integer type Friends = [UserId] type URIString = Text type UserName = Text type StatusId = Integer type LanguageCode = String data StreamingAPI = SStatus Status | SRetweetedStatus RetweetedStatus | SEvent Event | SDelete Delete -- | SScrubGeo ScrubGeo | SFriends Friends | SDirectMessage DirectMessage | SUnknown Value deriving (Show, Eq, Data, Typeable, Generic) checkError :: Object -> Parser () checkError o = do err <- o .:? "error" case err of Just msg -> fail msg Nothing -> return () twitterTimeFormat :: String twitterTimeFormat = "%a %b %d %T %z %Y" instance FromJSON TwitterTime where parseJSON = withText "TwitterTime" $ \t -> #if MIN_VERSION_time(1, 5, 0) case parseTimeM True defaultTimeLocale twitterTimeFormat (unpack t) of #else case parseTime defaultTimeLocale twitterTimeFormat (unpack t) of #endif Just d -> pure $ TwitterTime d Nothing -> fail $ "Could not parse twitter time. Text was: " ++ unpack t instance ToJSON TwitterTime where toJSON t = String $ pack $ formatTime defaultTimeLocale twitterTimeFormat $ fromTwitterTime t instance FromJSON StreamingAPI where parseJSON v@(Object o) = SRetweetedStatus <$> js <|> SStatus <$> js <|> SEvent <$> js <|> SDelete <$> js <|> SFriends <$> (o .: "friends") <|> SDirectMessage <$> (o .: "direct_message") <|> return (SUnknown v) where js :: FromJSON a => Parser a js = parseJSON v parseJSON v = fail $ "couldn't parse StreamingAPI from: " ++ show v instance ToJSON StreamingAPI where toJSON (SStatus s) = toJSON s toJSON (SRetweetedStatus s) = toJSON s toJSON (SEvent e) = toJSON e toJSON (SDelete d) = toJSON d toJSON (SFriends f) = toJSON f toJSON (SDirectMessage m) = toJSON m toJSON (SUnknown v) = v -- | This type represents a Twitter tweet structure. -- See . data Status = Status { statusContributors :: Maybe [Contributor] , statusCoordinates :: Maybe Coordinates , statusCreatedAt :: UTCTime , statusCurrentUserRetweet :: Maybe StatusId , statusEntities :: Maybe Entities , statusExtendedEntities :: Maybe Entities , statusFavoriteCount :: Integer , statusFavorited :: Maybe Bool , statusFilterLevel :: Maybe Text , statusId :: StatusId , statusInReplyToScreenName :: Maybe Text , statusInReplyToStatusId :: Maybe StatusId , statusInReplyToUserId :: Maybe UserId , statusLang :: Maybe LanguageCode , statusPlace :: Maybe Place , statusPossiblySensitive :: Maybe Bool , statusScopes :: Maybe Object , statusQuotedStatusId :: Maybe StatusId , statusQuotedStatus :: Maybe Status , statusRetweetCount :: Integer , statusRetweeted :: Maybe Bool , statusRetweetedStatus :: Maybe Status , statusSource :: Text , statusText :: Text , statusTruncated :: Bool , statusUser :: User , statusWithheldCopyright :: Maybe Bool , statusWithheldInCountries :: Maybe [Text] , statusWithheldScope :: Maybe Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Status where parseJSON (Object o) = checkError o >> Status <$> o .:? "contributors" .!= Nothing <*> o .:? "coordinates" .!= Nothing <*> (o .: "created_at" >>= return . fromTwitterTime) <*> ((o .: "current_user_retweet" >>= (.: "id")) <|> return Nothing) <*> o .:? "entities" <*> o .:? "extended_entities" <*> o .:? "favorite_count" .!= 0 <*> o .:? "favorited" <*> o .:? "filter_level" <*> o .: "id" <*> o .:? "in_reply_to_screen_name" .!= Nothing <*> o .:? "in_reply_to_status_id" .!= Nothing <*> o .:? "in_reply_to_user_id" .!= Nothing <*> o .:? "lang" <*> o .:? "place" .!= Nothing <*> o .:? "possibly_sensitive" <*> o .:? "scopes" <*> o .:? "quoted_status_id" <*> o .:? "quoted_status" <*> o .:? "retweet_count" .!= 0 <*> o .:? "retweeted" <*> o .:? "retweeted_status" <*> o .: "source" <*> o .: "text" <*> o .: "truncated" <*> o .: "user" <*> o .:? "withheld_copyright" <*> o .:? "withheld_in_countries" <*> o .:? "withheld_scope" parseJSON v = fail $ "couldn't parse status from: " ++ show v instance ToJSON Status where toJSON Status{..} = object [ "contributors" .= statusContributors , "coordinates" .= statusCoordinates , "created_at" .= TwitterTime statusCreatedAt , "current_user_retweet" .= object [ "id" .= statusCurrentUserRetweet , "id_str" .= show statusCurrentUserRetweet ] , "entities" .= statusEntities , "extended_entities" .= statusExtendedEntities , "favorite_count" .= statusFavoriteCount , "favorited" .= statusFavorited , "filter_level" .= statusFilterLevel , "id" .= statusId , "in_reply_to_screen_name" .= statusInReplyToScreenName , "in_reply_to_status_id" .= statusInReplyToStatusId , "in_reply_to_user_id" .= statusInReplyToUserId , "lang" .= statusLang , "place" .= statusPlace , "possibly_sensitive" .= statusPossiblySensitive , "scopes" .= statusScopes , "quoted_status_id" .= statusQuotedStatusId , "quoted_status" .= statusQuotedStatus , "retweet_count" .= statusRetweetCount , "retweeted" .= statusRetweeted , "retweeted_status" .= statusRetweetedStatus , "source" .= statusSource , "text" .= statusText , "truncated" .= statusTruncated , "user" .= statusUser , "withheld_copyright" .= statusWithheldCopyright , "withheld_in_countries" .= statusWithheldInCountries , "withheld_scope" .= statusWithheldScope ] data SearchResult body = SearchResult { searchResultStatuses :: body , searchResultSearchMetadata :: SearchMetadata } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON body => FromJSON (SearchResult body) where parseJSON (Object o) = checkError o >> SearchResult <$> o .: "statuses" <*> o .: "search_metadata" parseJSON v = fail $ "couldn't parse search result from: " ++ show v instance ToJSON body => ToJSON (SearchResult body) where toJSON SearchResult{..} = object [ "statuses" .= searchResultStatuses , "search_metadata" .= searchResultSearchMetadata ] data SearchStatus = SearchStatus { searchStatusCreatedAt :: UTCTime , searchStatusId :: StatusId , searchStatusText :: Text , searchStatusSource :: Text , searchStatusUser :: User , searchStatusCoordinates :: Maybe Coordinates } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON SearchStatus where parseJSON (Object o) = checkError o >> SearchStatus <$> (o .: "created_at" >>= return . fromTwitterTime) <*> o .: "id" <*> o .: "text" <*> o .: "source" <*> o .: "user" <*> o .:? "coordinates" parseJSON v = fail $ "couldn't parse status search result from: " ++ show v instance ToJSON SearchStatus where toJSON SearchStatus{..} = object [ "created_at" .= TwitterTime searchStatusCreatedAt , "id" .= searchStatusId , "text" .= searchStatusText , "source" .= searchStatusSource , "user" .= searchStatusUser , "coordinates" .= searchStatusCoordinates ] data SearchMetadata = SearchMetadata { searchMetadataMaxId :: StatusId , searchMetadataSinceId :: StatusId , searchMetadataRefreshURL :: URIString , searchMetadataNextResults :: Maybe URIString , searchMetadataCount :: Int , searchMetadataCompletedIn :: Maybe Float , searchMetadataSinceIdStr :: String , searchMetadataQuery :: String , searchMetadataMaxIdStr :: String } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON SearchMetadata where parseJSON (Object o) = checkError o >> SearchMetadata <$> o .: "max_id" <*> o .: "since_id" <*> o .: "refresh_url" <*> o .:? "next_results" <*> o .: "count" <*> o .:? "completed_in" <*> o .: "since_id_str" <*> o .: "query" <*> o .: "max_id_str" parseJSON v = fail $ "couldn't parse search metadata from: " ++ show v instance ToJSON SearchMetadata where toJSON SearchMetadata{..} = object [ "max_id" .= searchMetadataMaxId , "since_id" .= searchMetadataSinceId , "refresh_url" .= searchMetadataRefreshURL , "next_results" .= searchMetadataNextResults , "count" .= searchMetadataCount , "completed_in" .= searchMetadataCompletedIn , "since_id_str" .= searchMetadataSinceIdStr , "query" .= searchMetadataQuery , "max_id_str" .= searchMetadataMaxIdStr ] data RetweetedStatus = RetweetedStatus { rsCreatedAt :: UTCTime , rsId :: StatusId , rsText :: Text , rsSource :: Text , rsTruncated :: Bool , rsEntities :: Maybe Entities , rsUser :: User , rsRetweetedStatus :: Status , rsCoordinates :: Maybe Coordinates } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON RetweetedStatus where parseJSON (Object o) = checkError o >> RetweetedStatus <$> (o .: "created_at" >>= return . fromTwitterTime) <*> o .: "id" <*> o .: "text" <*> o .: "source" <*> o .: "truncated" <*> o .:? "entities" <*> o .: "user" <*> o .: "retweeted_status" <*> o .:? "coordinates" parseJSON v = fail $ "couldn't parse retweeted status from: " ++ show v instance ToJSON RetweetedStatus where toJSON RetweetedStatus{..} = object [ "created_at" .= TwitterTime rsCreatedAt , "id" .= rsId , "text" .= rsText , "source" .= rsSource , "truncated" .= rsTruncated , "entities" .= rsEntities , "user" .= rsUser , "retweeted_status" .= rsRetweetedStatus , "coordinates" .= rsCoordinates ] data DirectMessage = DirectMessage { dmCreatedAt :: UTCTime , dmSenderScreenName :: Text , dmSender :: User , dmText :: Text , dmRecipientScreeName :: Text , dmId :: StatusId , dmRecipient :: User , dmRecipientId :: UserId , dmSenderId :: UserId , dmCoordinates :: Maybe Coordinates } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON DirectMessage where parseJSON (Object o) = checkError o >> DirectMessage <$> (o .: "created_at" >>= return . fromTwitterTime) <*> o .: "sender_screen_name" <*> o .: "sender" <*> o .: "text" <*> o .: "recipient_screen_name" <*> o .: "id" <*> o .: "recipient" <*> o .: "recipient_id" <*> o .: "sender_id" <*> o .:? "coordinates" parseJSON v = fail $ "couldn't parse direct message from: " ++ show v instance ToJSON DirectMessage where toJSON DirectMessage{..} = object [ "created_at" .= TwitterTime dmCreatedAt , "sender_screen_name" .= dmSenderScreenName , "sender" .= dmSender , "text" .= dmText , "recipient_screen_name" .= dmRecipientScreeName , "id" .= dmId , "recipient" .= dmRecipient , "recipient_id" .= dmRecipientId , "sender_id" .= dmSenderId , "coordinates" .= dmCoordinates ] data EventType = Favorite | Unfavorite | ListCreated | ListUpdated | ListMemberAdded | UserUpdate | Block | Unblock | Follow deriving (Show, Eq, Data, Typeable, Generic) data EventTarget = ETUser User | ETStatus Status | ETList List | ETUnknown Value deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON EventTarget where parseJSON v@(Object o) = checkError o >> ETUser <$> parseJSON v <|> ETStatus <$> parseJSON v <|> ETList <$> parseJSON v <|> return (ETUnknown v) parseJSON v = fail $ "couldn't parse event target from: " ++ show v instance ToJSON EventTarget where toJSON (ETUser u) = toJSON u toJSON (ETStatus s) = toJSON s toJSON (ETList l) = toJSON l toJSON (ETUnknown v) = v data Event = Event { evCreatedAt :: UTCTime , evTargetObject :: Maybe EventTarget , evEvent :: Text , evTarget :: EventTarget , evSource :: EventTarget } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Event where parseJSON (Object o) = checkError o >> Event <$> (o .: "created_at" >>= return . fromTwitterTime) <*> o .:? "target_object" <*> o .: "event" <*> o .: "target" <*> o .: "source" parseJSON v = fail $ "couldn't parse event from: " ++ show v instance ToJSON Event where toJSON Event{..} = object [ "created_at" .= TwitterTime evCreatedAt , "target_object" .= evTargetObject , "event" .= evEvent , "target" .= evTarget , "source" .= evSource ] data Delete = Delete { delId :: StatusId , delUserId :: UserId } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Delete where parseJSON (Object o) = checkError o >> do s <- o .: "delete" >>= (.: "status") Delete <$> s .: "id" <*> s .: "user_id" parseJSON v = fail $ "couldn't parse delete from: " ++ show v instance ToJSON Delete where toJSON Delete{..} = object [ "delete" .= object [ "status" .= object [ "id" .= delId , "user_id" .= delUserId ] ] ] -- | This type represents the Twitter user. -- See . data User = User { userContributorsEnabled :: Bool , userCreatedAt :: UTCTime , userDefaultProfile :: Bool , userDefaultProfileImage :: Bool , userDescription :: Maybe Text , userFavoritesCount :: Int , userFollowRequestSent :: Maybe Bool , userFollowing :: Maybe Bool , userFollowersCount :: Int , userFriendsCount :: Int , userGeoEnabled :: Bool , userId :: UserId , userIsTranslator :: Bool , userLang :: LanguageCode , userListedCount :: Int , userLocation :: Maybe Text , userName :: Text , userNotifications :: Maybe Bool , userProfileBackgroundColor :: Maybe Text , userProfileBackgroundImageURL :: Maybe URIString , userProfileBackgroundImageURLHttps :: Maybe URIString , userProfileBackgroundTile :: Maybe Bool , userProfileBannerURL :: Maybe URIString , userProfileImageURL :: Maybe URIString , userProfileImageURLHttps :: Maybe URIString , userProfileLinkColor :: Text , userProfileSidebarBorderColor :: Text , userProfileSidebarFillColor :: Text , userProfileTextColor :: Text , userProfileUseBackgroundImage :: Bool , userProtected :: Bool , userScreenName :: Text , userShowAllInlineMedia :: Maybe Bool , userStatusesCount :: Int , userTimeZone :: Maybe Text , userURL :: Maybe URIString , userUtcOffset :: Maybe Int , userVerified :: Bool , userWithheldInCountries :: Maybe [Text] , userWithheldScope :: Maybe Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON User where parseJSON (Object o) = checkError o >> User <$> o .: "contributors_enabled" <*> (o .: "created_at" >>= return . fromTwitterTime) <*> o .: "default_profile" <*> o .: "default_profile_image" <*> o .:? "description" <*> o .: "favourites_count" <*> o .:? "follow_request_sent" .!= Nothing <*> o .:? "following" .!= Nothing <*> o .: "followers_count" <*> o .: "friends_count" <*> o .: "geo_enabled" <*> o .: "id" <*> o .: "is_translator" <*> o .: "lang" <*> o .: "listed_count" <*> o .:? "location" <*> o .: "name" <*> o .:? "notifications" .!= Nothing <*> o .:? "profile_background_color" <*> o .:? "profile_background_image_url" <*> o .:? "profile_background_image_url_https" <*> o .:? "profile_background_tile" <*> o .:? "profile_banner_url" <*> o .:? "profile_image_url" <*> o .:? "profile_image_url_https" <*> o .: "profile_link_color" <*> o .: "profile_sidebar_border_color" <*> o .: "profile_sidebar_fill_color" <*> o .: "profile_text_color" <*> o .: "profile_use_background_image" <*> o .: "protected" <*> o .: "screen_name" <*> o .:? "show_all_inline_media" <*> o .: "statuses_count" <*> o .:? "time_zone" <*> o .:? "url" .!= Nothing <*> o .:? "utc_offset" <*> o .: "verified" <*> o .:? "withheld_in_countries" <*> o .:? "withheld_scope" parseJSON v = fail $ "couldn't parse user from: " ++ show v instance ToJSON User where toJSON User{..} = object [ "contributors_enabled" .= userContributorsEnabled , "created_at" .= TwitterTime userCreatedAt , "default_profile" .= userDefaultProfile , "default_profile_image" .= userDefaultProfileImage , "description" .= userDescription , "favourites_count" .= userFavoritesCount , "follow_request_sent" .= userFollowRequestSent , "following" .= userFollowing , "followers_count" .= userFollowersCount , "friends_count" .= userFriendsCount , "geo_enabled" .= userGeoEnabled , "id" .= userId , "is_translator" .= userIsTranslator , "lang" .= userLang , "listed_count" .= userListedCount , "location" .= userLocation , "name" .= userName , "notifications" .= userNotifications , "profile_background_color" .= userProfileBackgroundColor , "profile_background_image_url" .= userProfileBackgroundImageURL , "profile_background_image_url_https" .= userProfileBackgroundImageURLHttps , "profile_background_tile" .= userProfileBackgroundTile , "profile_banner_url" .= userProfileBannerURL , "profile_image_url" .= userProfileImageURL , "profile_image_url_https" .= userProfileImageURLHttps , "profile_link_color" .= userProfileLinkColor , "profile_sidebar_border_color" .= userProfileSidebarBorderColor , "profile_sidebar_fill_color" .= userProfileSidebarFillColor , "profile_text_color" .= userProfileTextColor , "profile_use_background_image" .= userProfileUseBackgroundImage , "protected" .= userProtected , "screen_name" .= userScreenName , "show_all_inline_media" .= userShowAllInlineMedia , "statuses_count" .= userStatusesCount , "time_zone" .= userTimeZone , "url" .= userURL , "utc_offset" .= userUtcOffset , "verified" .= userVerified , "withheld_in_countries" .= userWithheldInCountries , "withheld_scope" .= userWithheldScope ] data List = List { listId :: Int , listName :: Text , listFullName :: Text , listMemberCount :: Int , listSubscriberCount :: Int , listMode :: Text , listUser :: User } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON List where parseJSON (Object o) = checkError o >> List <$> o .: "id" <*> o .: "name" <*> o .: "full_name" <*> o .: "member_count" <*> o .: "subscriber_count" <*> o .: "mode" <*> o .: "user" parseJSON v = fail $ "couldn't parse List from: " ++ show v instance ToJSON List where toJSON List{..} = object [ "id" .= listId , "name" .= listName , "full_name" .= listFullName , "member_count" .= listMemberCount , "subscriber_count" .= listSubscriberCount , "mode" .= listMode , "user" .= listUser ] -- | Hashtag entity. -- See . data HashTagEntity = HashTagEntity { hashTagText :: Text -- ^ The Hashtag text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON HashTagEntity where parseJSON (Object o) = HashTagEntity <$> o .: "text" parseJSON v = fail $ "couldn't parse hashtag entity from: " ++ show v instance ToJSON HashTagEntity where toJSON HashTagEntity{..} = object [ "text" .= hashTagText ] -- | User mention entity. -- See . data UserEntity = UserEntity { userEntityUserId :: UserId , userEntityUserName :: UserName , userEntityUserScreenName :: Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON UserEntity where parseJSON (Object o) = UserEntity <$> o .: "id" <*> o .: "name" <*> o .: "screen_name" parseJSON v = fail $ "couldn't parse user entity from: " ++ show v instance ToJSON UserEntity where toJSON UserEntity{..} = object [ "id" .= userEntityUserId , "name" .= userEntityUserName , "screen_name" .= userEntityUserScreenName ] -- | URL entity. -- See . data URLEntity = URLEntity { ueURL :: URIString -- ^ The URL that was extracted , ueExpanded :: URIString -- ^ The fully resolved URL (only for t.co links) , ueDisplay :: Text -- ^ Not a URL but a string to display instead of the URL (only for t.co links) } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON URLEntity where parseJSON (Object o) = URLEntity <$> o .: "url" <*> o .: "expanded_url" <*> o .: "display_url" parseJSON v = fail $ "couldn't parse url entity from: " ++ show v instance ToJSON URLEntity where toJSON URLEntity{..} = object [ "url" .= ueURL , "expanded_url" .= ueExpanded , "display_url" .= ueDisplay ] data MediaEntity = MediaEntity { meType :: Text , meId :: StatusId , meSizes :: HashMap Text MediaSize , meMediaURL :: URIString , meMediaURLHttps :: URIString , meURL :: URLEntity } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON MediaEntity where parseJSON v@(Object o) = MediaEntity <$> o .: "type" <*> o .: "id" <*> o .: "sizes" <*> o .: "media_url" <*> o .: "media_url_https" <*> parseJSON v parseJSON v = fail $ "couldn't parse media entity from: " ++ show v instance ToJSON MediaEntity where toJSON MediaEntity{..} = object [ "type" .= meType , "id" .= meId , "sizes" .= meSizes , "media_url" .= meMediaURL , "media_url_https" .= meMediaURLHttps , "url" .= ueURL meURL , "expanded_url" .= ueExpanded meURL , "display_url" .= ueDisplay meURL ] -- | Size entity. -- See . data MediaSize = MediaSize { msWidth :: Int , msHeight :: Int , msResize :: Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON MediaSize where parseJSON (Object o) = MediaSize <$> o .: "w" <*> o .: "h" <*> o .: "resize" parseJSON v = fail $ "couldn't parse media size from: " ++ show v instance ToJSON MediaSize where toJSON MediaSize{..} = object [ "w" .= msWidth , "h" .= msHeight , "resize" .= msResize ] data Coordinates = Coordinates { coordinates :: [Double] , coordinatesType :: Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Coordinates where parseJSON (Object o) = Coordinates <$> o .: "coordinates" <*> o .: "type" parseJSON v = fail $ "couldn't parse coordinates from: " ++ show v instance ToJSON Coordinates where toJSON Coordinates{..} = object [ "coordinates" .= coordinates , "type" .= coordinatesType ] -- | This type represents a place, named locations with corresponding geo coordinates. -- See . data Place = Place { placeAttributes :: HashMap Text Text , placeBoundingBox :: Maybe BoundingBox , placeCountry :: Text , placeCountryCode :: Text , placeFullName :: Text , placeId :: Text , placeName :: Text , placeType :: Text , placeURL :: Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Place where parseJSON (Object o) = Place <$> o .: "attributes" <*> o .:? "bounding_box" <*> o .: "country" <*> o .: "country_code" <*> o .: "full_name" <*> o .: "id" <*> o .: "name" <*> o .: "place_type" <*> o .: "url" parseJSON v = fail $ "couldn't parse place from: " ++ show v instance ToJSON Place where toJSON Place{..} = object [ "attributes" .= placeAttributes , "bounding_box" .= placeBoundingBox , "country" .= placeCountry , "country_code" .= placeCountryCode , "full_name" .= placeFullName , "id" .= placeId , "name" .= placeName , "place_type" .= placeType , "url" .= placeURL ] -- | A bounding box of coordinates which encloses the place. -- See . data BoundingBox = BoundingBox { boundingBoxCoordinates :: [[[Double]]] , boundingBoxType :: Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON BoundingBox where parseJSON (Object o) = BoundingBox <$> o .: "coordinates" <*> o .: "type" parseJSON v = fail $ "couldn't parse bounding box from: " ++ show v instance ToJSON BoundingBox where toJSON BoundingBox{..} = object [ "coordinates" .= boundingBoxCoordinates , "type" .= boundingBoxType ] -- | Entity handling. -- See . data Entities = Entities { enHashTags :: [Entity HashTagEntity] , enUserMentions :: [Entity UserEntity] , enURLs :: [Entity URLEntity] , enMedia :: [Entity MediaEntity] } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Entities where parseJSON (Object o) = Entities <$> o .:? "hashtags" .!= [] <*> o .:? "user_mentions" .!= [] <*> o .:? "urls" .!= [] <*> o .:? "media" .!= [] parseJSON v = fail $ "couldn't parse entities from: " ++ show v instance ToJSON Entities where toJSON Entities{..} = object [ "hashtags" .= enHashTags , "user_mentions" .= enUserMentions , "urls" .= enURLs , "media" .= enMedia ] -- | The character positions the Entity was extracted from -- -- This is experimental implementation. -- This may be replaced by more definite types. type EntityIndices = [Int] data Entity a = Entity { entityBody :: a -- ^ The detail information of the specific entity types (HashTag, URL, User) , entityIndices :: EntityIndices -- ^ The character positions the Entity was extracted from } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON a => FromJSON (Entity a) where parseJSON v@(Object o) = Entity <$> parseJSON v <*> o .: "indices" parseJSON v = fail $ "couldn't parse entity wrapper from: " ++ show v instance ToJSON a => ToJSON (Entity a) where toJSON Entity{..} = case toJSON entityBody of (Object o) -> Object $ union o $ fromList [("indices"::Text, toJSON entityIndices)] _ -> error "Entity body must produce an object." data Contributor = Contributor { contributorId :: UserId , contributorScreenName :: Maybe Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Contributor where parseJSON (Object o) = Contributor <$> o .: "id" <*> o .:? "screen_name" parseJSON v@(Number _) = Contributor <$> parseJSON v <*> pure Nothing parseJSON v = fail $ "couldn't parse contributor from: " ++ show v instance ToJSON Contributor where toJSON Contributor{..} = object [ "id" .= contributorId , "screen_name" .= contributorScreenName ] -- | Image size type. This type is included in the API response of \"\/1.1\/media\/upload.json\". data ImageSizeType = ImageSizeType { imageSizeTypeWidth :: Int , imageSizeTypeHeight :: Int , imageSizeTypeType :: Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON ImageSizeType where parseJSON (Object o) = ImageSizeType <$> o .: "w" <*> o .: "h" <*> o .: "image_type" parseJSON v = fail $ "unknown value: " ++ show v instance ToJSON ImageSizeType where toJSON ImageSizeType{..} = object [ "w" .= imageSizeTypeWidth , "h" .= imageSizeTypeHeight , "image_type" .= imageSizeTypeType ] -- | This type is represents the API response of \"\/1.1\/media\/upload.json\". -- See . data UploadedMedia = UploadedMedia { uploadedMediaId :: Integer , uploadedMediaSize :: Integer , uploadedMediaImage :: ImageSizeType } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON UploadedMedia where parseJSON (Object o) = UploadedMedia <$> o .: "media_id" <*> o .: "size" <*> o .: "image" parseJSON v = fail $ "unknown value: " ++ show v instance ToJSON UploadedMedia where toJSON UploadedMedia{..} = object [ "media_id" .= uploadedMediaId , "size" .= uploadedMediaSize , "image" .= uploadedMediaImage ] twitter-types-0.7.2.2/tests/TypesTest.hs0000644000000000000000000004022612730546400016361 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where import Web.Twitter.Types import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit import Data.Aeson hiding (Error) import Data.Aeson.Types (parseEither) import qualified Data.Aeson.Types as Aeson import qualified Data.HashMap.Strict as M import Data.Maybe import Instances() import Fixtures loadFixturesTH 'parseJSONValue main :: IO () main = defaultMain [ testGroup "Unit tests" unittests , testGroup "Property tests" proptests ] where unittests = [ testCase "case_parseStatus" case_parseStatus , testCase "case_parseStatusQuoted" case_parseStatusQuoted , testCase "case_parseStatusWithPhoto" case_parseStatusWithPhoto , testCase "case_parseStatusIncludeEntities" case_parseStatusIncludeEntities , testCase "case_parseSearchStatusMetadata" case_parseSearchStatusMetadata , testCase "case_parseSearchStatusBodyStatus" case_parseSearchStatusBodyStatus , testCase "case_parseSearchStatusBodySearchStatus" case_parseSearchStatusBodySearchStatus , testCase "case_parseDirectMessage" case_parseDirectMessage , testCase "case_parseEventFavorite" case_parseEventFavorite , testCase "case_parseEventUnfavorite" case_parseEventUnfavorite , testCase "case_parseDelete" case_parseDelete , testCase "case_parseErrorMsg" case_parseErrorMsg , testCase "case_parseMediaEntity" case_parseMediaEntity , testCase "case_parseEmptyEntity" case_parseEmptyEntity , testCase "case_parseEntityHashTag" case_parseEntityHashTag , testCase "case_parseExtendedEntities" case_parseExtendedEntities , testCase "case_parseUser" case_parseUser , testCase "case_parseList" case_parseList ] proptests = [ testProperty "prop_fromToStatus" prop_fromToStatus , testProperty "prop_fromToSearchStatus" prop_fromToSearchStatus , testProperty "prop_fromToSearchMetadata" prop_fromToSearchMetadata , testProperty "prop_fromToRetweetedStatus" prop_fromToRetweetedStatus , testProperty "prop_fromToDirectMessage" prop_fromToDirectMessage , testProperty "prop_fromToEventTarget" prop_fromToEventTarget , testProperty "prop_fromToEvent" prop_fromToEvent , testProperty "prop_fromToDelete" prop_fromToDelete , testProperty "prop_fromToUser" prop_fromToUser , testProperty "prop_fromToList" prop_fromToList , testProperty "prop_fromToHashTagEntity" prop_fromToHashTagEntity , testProperty "prop_fromToUserEntity" prop_fromToUserEntity , testProperty "prop_fromToURLEntity" prop_fromToURLEntity , testProperty "prop_fromToMediaEntity" prop_fromToMediaEntity , testProperty "prop_fromToMediaSize" prop_fromToMediaSize , testProperty "prop_fromToCoordinates" prop_fromToCoordinates , testProperty "prop_fromToPlace" prop_fromToPlace , testProperty "prop_fromToBoundingBox" prop_fromToBoundingBox , testProperty "prop_fromToEntities" prop_fromToEntities , testProperty "prop_fromToContributor" prop_fromToContributor , testProperty "prop_fromToImageSizeType" prop_fromToImageSizeType , testProperty "prop_fromToUploadedMedia" prop_fromToUploadedMedia ] withJSON :: FromJSON a => Value -> (a -> Assertion) -> Assertion withJSON js f = either assertFailure id $ do o <- parseEither parseJSON js return $ f o case_parseStatus :: Assertion case_parseStatus = withJSON fixture_status01 $ \obj -> do statusCreatedAt obj @?= "Sat Sep 10 22:23:38 +0000 2011" statusId obj @?= 112652479837110273 statusText obj @?= "@twitter meets @seepicturely at #tcdisrupt cc.@boscomonkey @episod http://t.co/6J2EgYM" statusSource obj @?= "Instagram" statusTruncated obj @?= False statusEntities obj @?= Nothing statusExtendedEntities obj @?= Nothing statusInReplyToStatusId obj @?= Nothing statusInReplyToUserId obj @?= Just 783214 statusFavorited obj @?= Just False statusQuotedStatus obj @?= Nothing statusQuotedStatusId obj @?= Nothing statusRetweetCount obj @?= 0 (userScreenName . statusUser) obj @?= "imeoin" statusRetweetedStatus obj @?= Nothing statusPlace obj @?= Nothing statusFavoriteCount obj @?= 0 statusLang obj @?= Nothing statusPossiblySensitive obj @?= Just False statusCoordinates obj @?= Nothing case_parseStatusQuoted :: Assertion case_parseStatusQuoted = withJSON fixture_status_quoted $ \obj -> do statusId obj @?= 641660763770372100 statusText obj @?= "Wow! Congrats! https://t.co/EPMMldEcci" statusQuotedStatusId obj @?= Just 641653574284537900 let qs = fromJust $ statusQuotedStatus obj statusCreatedAt qs @?= "Wed Sep 09 16:45:08 +0000 2015" statusId qs @?= 641653574284537900 statusText qs @?= "Very happy to say that I'm joining @mesosphere as a Distributed Systems Engineer!" statusSource qs @?= "Twitter Web Client" let ent = fromJust $ statusEntities qs enURLs ent @?= [] enMedia ent @?= [] enHashTags ent @?= [] map (userEntityUserId . entityBody) (enUserMentions ent) @?= [1872399366] map (userEntityUserScreenName . entityBody) (enUserMentions ent) @?= ["mesosphere"] statusExtendedEntities qs @?= Nothing statusInReplyToStatusId qs @?= Nothing statusInReplyToUserId qs @?= Nothing statusFavorited qs @?= Just False statusQuotedStatus qs @?= Nothing statusQuotedStatusId qs @?= Nothing statusRetweetCount qs @?= 7 (userScreenName . statusUser) qs @?= "neil_conway" statusRetweeted qs @?= Just False statusRetweetedStatus qs @?= Nothing statusPlace qs @?= Nothing statusFavoriteCount qs @?= 63 statusLang qs @?= Just "en" statusPossiblySensitive qs @?= Nothing statusCoordinates qs @?= Nothing case_parseStatusWithPhoto :: Assertion case_parseStatusWithPhoto = withJSON fixture_status_thimura_with_photo $ \obj -> do statusId obj @?= 491143410770657280 statusText obj @?= "近所の海です http://t.co/FjSOU8dDoD" statusTruncated obj @?= False let ent = fromJust $ statusEntities obj enHashTags ent @?= [] enUserMentions ent @?= [] enURLs ent @?= [] length (enMedia ent) @?= 1 map (meMediaURLHttps . entityBody) (enMedia ent) @?= ["https://pbs.twimg.com/media/BtDkUVaCQAIpWBU.jpg"] let exent = fromJust $ statusExtendedEntities obj enHashTags exent @?= [] enUserMentions exent @?= [] enURLs exent @?= [] length (enMedia ent) @?= 1 statusInReplyToStatusId obj @?= Nothing statusInReplyToUserId obj @?= Nothing statusFavorited obj @?= Just False statusRetweetCount obj @?= 4 (userScreenName . statusUser) obj @?= "thimura" statusRetweetedStatus obj @?= Nothing statusPlace obj @?= Nothing statusFavoriteCount obj @?= 9 statusLang obj @?= Just "ja" statusPossiblySensitive obj @?= Just False statusCoordinates obj @?= Nothing case_parseStatusIncludeEntities :: Assertion case_parseStatusIncludeEntities = withJSON fixture_status_with_entity $ \obj -> do statusId obj @?= 112652479837110273 statusRetweetCount obj @?= 0 (userScreenName . statusUser) obj @?= "imeoin" let ent = fromMaybe (Entities [] [] [] []) $ statusEntities obj (map entityIndices . enHashTags) ent @?= [[32,42]] (hashTagText . entityBody . head . enHashTags) ent @?= "tcdisrupt" case_parseSearchStatusMetadata :: Assertion case_parseSearchStatusMetadata = withJSON fixture_search_haskell $ \obj -> do let status = (searchResultStatuses obj) :: [Status] length status @?= 1 let metadata = searchResultSearchMetadata obj searchMetadataMaxId metadata @?= 495597397733433345 searchMetadataSinceId metadata @?= 0 searchMetadataRefreshURL metadata @?= "?since_id=495597397733433345&q=haskell&include_entities=1" searchMetadataNextResults metadata @?= Just "?max_id=495594369802440705&q=haskell&include_entities=1" searchMetadataCount metadata @?= 1 searchMetadataCompletedIn metadata @?= Just 0.043 searchMetadataSinceIdStr metadata @?= "0" searchMetadataQuery metadata @?= "haskell" searchMetadataMaxIdStr metadata @?= "495597397733433345" case_parseSearchStatusBodyStatus :: Assertion case_parseSearchStatusBodyStatus = withJSON fixture_search_haskell $ \obj -> do let status = (searchResultStatuses obj) :: [Status] length status @?= 1 statusText (head status) @?= "haskell" case_parseSearchStatusBodySearchStatus :: Assertion case_parseSearchStatusBodySearchStatus = withJSON fixture_search_haskell $ \obj -> do let status = (searchResultStatuses obj) :: [SearchStatus] length status @?= 1 searchStatusText (head status) @?= "haskell" case_parseDirectMessage :: Assertion case_parseDirectMessage = withJSON fixture_direct_message_thimura $ \obj -> do dmCreatedAt obj @?= "Sat Aug 02 16:10:04 +0000 2014" dmSenderScreenName obj @?= "thimura_shinku" (userScreenName . dmSender) obj @?= "thimura_shinku" dmText obj @?= "おまえの明日が、今日よりもずっと、楽しい事で溢れているようにと、祈っているよ" dmRecipientScreeName obj @?= "thimura" dmId obj @?= 495602442466123776 (userScreenName . dmRecipient) obj @?= "thimura" dmRecipientId obj @?= 69179963 dmSenderId obj @?= 2566877347 dmCoordinates obj @?= Nothing case_parseEventFavorite :: Assertion case_parseEventFavorite = withJSON fixture_event_favorite_thimura $ \obj -> do evCreatedAt obj @?= "Sat Aug 02 16:32:01 +0000 2014" evEvent obj @?= "favorite" let Just (ETStatus targetObj) = evTargetObject obj statusId targetObj @?= 495597326736449536 statusText targetObj @?= "haskell" let ETUser targetUser = evTarget obj userScreenName targetUser @?= "thimura" let ETUser sourceUser = evSource obj userScreenName sourceUser @?= "thimura_shinku" case_parseEventUnfavorite :: Assertion case_parseEventUnfavorite = withJSON fixture_event_unfavorite_thimura $ \obj -> do evCreatedAt obj @?= "Sat Aug 02 16:32:10 +0000 2014" evEvent obj @?= "unfavorite" let Just (ETStatus targetObj) = evTargetObject obj statusId targetObj @?= 495597326736449536 statusText targetObj @?= "haskell" let ETUser targetUser = evTarget obj userScreenName targetUser @?= "thimura" let ETUser sourceUser = evSource obj userScreenName sourceUser @?= "thimura_shinku" case_parseDelete :: Assertion case_parseDelete = withJSON fixture_delete $ \obj -> do delId obj @?= 495607981833064448 delUserId obj @?= 2566877347 case_parseErrorMsg :: Assertion case_parseErrorMsg = case parseStatus fixture_error_not_authorized of Aeson.Error str -> "Not authorized" @=? str Aeson.Success _ -> assertFailure "errorMsgJson should be parsed as an error." where parseStatus :: Value -> Aeson.Result Status parseStatus = Aeson.parse parseJSON case_parseMediaEntity :: Assertion case_parseMediaEntity = withJSON fixture_media_entity $ \obj -> do let entities = statusEntities obj assert $ isJust entities let Just ent = entities media = enMedia ent length media @?= 1 let me = entityBody $ head media meType me @?= "photo" meId me @?= 114080493040967680 let sizes = meSizes me assert $ M.member "thumb" sizes assert $ M.member "large" sizes let Just mediaSize = M.lookup "large" sizes msWidth mediaSize @?= 226 msHeight mediaSize @?= 238 msResize mediaSize @?= "fit" ueURL (meURL me) @?= "http://t.co/rJC5Pxsu" meMediaURLHttps me @?= "https://pbs.twimg.com/media/AZVLmp-CIAAbkyy.jpg" case_parseEmptyEntity :: Assertion case_parseEmptyEntity = withJSON (parseJSONValue "{}") $ \entity -> do length (enHashTags entity) @?= 0 length (enUserMentions entity) @?= 0 length (enURLs entity) @?= 0 length (enMedia entity) @?= 0 case_parseEntityHashTag :: Assertion case_parseEntityHashTag = withJSON fixture_entity01 $ \entity -> do length (enHashTags entity) @?= 1 length (enUserMentions entity) @?= 1 length (enURLs entity) @?= 1 length (enMedia entity) @?= 0 let urlEntity = entityBody . head . enURLs $ entity ueURL urlEntity @?= "http://t.co/IOwBrTZR" ueExpanded urlEntity @?= "http://www.youtube.com/watch?v=oHg5SJYRHA0" ueDisplay urlEntity @?= "youtube.com/watch?v=oHg5SJ\x2026" let mentionsUser = entityBody . head . enUserMentions $ entity userEntityUserName mentionsUser @?= "Twitter API" userEntityUserScreenName mentionsUser @?= "twitterapi" userEntityUserId mentionsUser @?= 6253282 let HashTagEntity hashtag = entityBody . head . enHashTags $ entity hashtag @?= "lol" case_parseExtendedEntities :: Assertion case_parseExtendedEntities = withJSON fixture_media_extended_entity $ \obj -> do let entities = statusExtendedEntities obj assert $ isJust entities let Just ent = entities media = enMedia ent length media @?= 4 let me = entityBody $ head media ueURL (meURL me) @?= "http://t.co/qOjPwmgLKO" meMediaURL me @?= "http://pbs.twimg.com/media/BqgdlpaCQAA5OSu.jpg" case_parseUser :: Assertion case_parseUser = withJSON fixture_user_thimura $ \obj -> do userId obj @?= 69179963 userName obj @?= "ちむら" userScreenName obj @?= "thimura" userDescription obj @?= Just "真紅かわいい" userLocation obj @?= Just "State# Irotoridori.No.World" userProfileImageURL obj @?= Just "http://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png" userURL obj @?= Just "http://t.co/TFUAsAffX0" userProtected obj @?= False userFollowersCount obj @?= 754 userFriendsCount obj @?= 780 userStatusesCount obj @?= 24709 userLang obj @?= "en" userCreatedAt obj @?= "Thu Aug 27 02:48:06 +0000 2009" userFavoritesCount obj @?= 17313 case_parseList :: Assertion case_parseList = withJSON fixture_list_thimura_haskell $ \obj -> do listId obj @?= 20849097 listName obj @?= "haskell" listFullName obj @?= "@thimura/haskell" listMemberCount obj @?= 50 listSubscriberCount obj @?= 1 listMode obj @?= "public" (userScreenName . listUser) obj @?= "thimura" fromToJSON :: (Eq a, FromJSON a, ToJSON a) => a -> Bool fromToJSON obj = case fromJSON . toJSON $ obj of Aeson.Error _ -> False Aeson.Success a -> a == obj -- prop_fromToStreamingAPI :: StreamingAPI -> Bool -- prop_fromToStreamingAPI = fromToJSON prop_fromToStatus :: Status -> Bool prop_fromToStatus = fromToJSON prop_fromToSearchStatus :: SearchStatus -> Bool prop_fromToSearchStatus = fromToJSON prop_fromToSearchMetadata :: SearchMetadata -> Bool prop_fromToSearchMetadata = fromToJSON prop_fromToRetweetedStatus :: RetweetedStatus -> Bool prop_fromToRetweetedStatus = fromToJSON prop_fromToDirectMessage :: DirectMessage -> Bool prop_fromToDirectMessage = fromToJSON prop_fromToEventTarget :: EventTarget -> Bool prop_fromToEventTarget = fromToJSON prop_fromToEvent :: Event -> Bool prop_fromToEvent = fromToJSON prop_fromToDelete :: Delete -> Bool prop_fromToDelete = fromToJSON prop_fromToUser :: User -> Bool prop_fromToUser = fromToJSON prop_fromToList :: List -> Bool prop_fromToList = fromToJSON prop_fromToHashTagEntity :: HashTagEntity -> Bool prop_fromToHashTagEntity = fromToJSON prop_fromToUserEntity :: UserEntity -> Bool prop_fromToUserEntity = fromToJSON prop_fromToURLEntity :: URLEntity -> Bool prop_fromToURLEntity = fromToJSON prop_fromToMediaEntity :: MediaEntity -> Bool prop_fromToMediaEntity = fromToJSON prop_fromToMediaSize :: MediaSize -> Bool prop_fromToMediaSize = fromToJSON prop_fromToCoordinates :: Coordinates -> Bool prop_fromToCoordinates = fromToJSON prop_fromToPlace :: Place -> Bool prop_fromToPlace = fromToJSON prop_fromToBoundingBox :: BoundingBox -> Bool prop_fromToBoundingBox = fromToJSON prop_fromToEntities :: Entities -> Bool prop_fromToEntities = fromToJSON prop_fromToContributor :: Contributor -> Bool prop_fromToContributor = fromToJSON prop_fromToImageSizeType :: ImageSizeType -> Bool prop_fromToImageSizeType = fromToJSON prop_fromToUploadedMedia :: UploadedMedia -> Bool prop_fromToUploadedMedia = fromToJSON twitter-types-0.7.2.2/tests/Fixtures.hs0000644000000000000000000000236412730546400016227 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Fixtures where import Language.Haskell.TH import Data.Aeson import Data.Attoparsec.ByteString import qualified Data.ByteString as S import Data.Maybe import System.Directory import System.FilePath import System.IO.Unsafe (unsafePerformIO) import Control.Applicative parseJSONValue :: S.ByteString -> Value parseJSONValue = fromJust . maybeResult . parse json fixturePath :: String fixturePath = takeDirectory __FILE__ "fixtures" loadFixture :: (S.ByteString -> a) -> String -> IO a loadFixture conv filename = conv <$> S.readFile (fixturePath filename) fixture :: (S.ByteString -> a) -> String -> a fixture conv = unsafePerformIO . loadFixture conv loadFixturesTH :: Name -> Q [Dec] loadFixturesTH convFn = do files <- runIO $ filter (\fn -> takeExtension fn == ".json") <$> getDirectoryContents fixturePath concat <$> mapM genEachDefs files where genEachDefs filename = do let funN = mkName $ "fixture_" ++ dropExtension filename sigdef <- sigD funN (conT ''Value) bind <- valD (varP funN) (normalB [|fixture $(varE convFn) $(litE (stringL filename))|]) [] return [ sigdef, bind ] twitter-types-0.7.2.2/tests/Instances.hs0000644000000000000000000000733212730546400016345 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Instances where import Data.String import Control.Applicative import Data.DeriveTH import qualified Data.Text as T import Test.QuickCheck import Web.Twitter.Types import Data.Aeson import Data.HashMap.Strict as HashMap #if MIN_VERSION_time(1,5,0) import Data.Time (UTCTime (..), readTime, fromGregorian, defaultTimeLocale) #else import Data.Time (UTCTime (..), readTime, fromGregorian) import System.Locale #endif instance IsString UTCTime where fromString = readTime defaultTimeLocale twitterTimeFormat instance Arbitrary UTCTime where arbitrary = do randomDay <- choose (1, 29) :: Gen Int randomMonth <- choose (1, 12) :: Gen Int randomYear <- choose (2001, 2002) :: Gen Integer randomTime <- choose (0, 86401) :: Gen Int return $ UTCTime (fromGregorian randomYear randomMonth randomDay) (fromIntegral randomTime) instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary instance Arbitrary Value where arbitrary = elements [ Object HashMap.empty , Object (HashMap.fromList [("test", Number 2), ("value", String "non empty")]) ] -- derive makeArbitrary ''StreamingAPI instance Arbitrary Status where arbitrary = do qt <- frequency [(5, Just <$> arbitrary), (95, pure Nothing)] :: Gen (Maybe Status) rt <- frequency [(5, Just <$> arbitrary), (95, pure Nothing)] :: Gen (Maybe Status) Status <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> pure Nothing <*> pure (statusId <$> qt) <*> pure qt <*> arbitrary <*> arbitrary <*> pure rt <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary derive makeArbitrary ''SearchStatus derive makeArbitrary ''SearchMetadata derive makeArbitrary ''RetweetedStatus derive makeArbitrary ''DirectMessage derive makeArbitrary ''EventTarget derive makeArbitrary ''Event derive makeArbitrary ''Delete derive makeArbitrary ''User derive makeArbitrary ''List derive makeArbitrary ''HashTagEntity derive makeArbitrary ''UserEntity derive makeArbitrary ''URLEntity instance Arbitrary MediaEntity where arbitrary = do ms <- arbitrary MediaEntity <$> arbitrary <*> arbitrary <*> pure (HashMap.fromList [("medium", ms)]) <*> arbitrary <*> arbitrary <*> arbitrary derive makeArbitrary ''MediaSize derive makeArbitrary ''Coordinates instance Arbitrary Place where arbitrary = do Place HashMap.empty <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary derive makeArbitrary ''BoundingBox derive makeArbitrary ''Entities instance Arbitrary a => Arbitrary (Entity a) where arbitrary = do a <- arbitrary ind <- arbitrary return $ Entity a ind derive makeArbitrary ''Contributor derive makeArbitrary ''ImageSizeType derive makeArbitrary ''UploadedMedia twitter-types-0.7.2.2/LICENSE0000644000000000000000000000245312730546400013724 0ustar0000000000000000Copyright (c)2011, Takahiro Himura All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. twitter-types-0.7.2.2/Setup.hs0000644000000000000000000000011012730546400014337 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain twitter-types-0.7.2.2/twitter-types.cabal0000644000000000000000000000311012730546400016536 0ustar0000000000000000name: twitter-types version: 0.7.2.2 license: BSD3 license-file: LICENSE author: Takahiro HIMURA maintainer: Takahiro HIMURA synopsis: Twitter JSON parser and types description: This package uses enumerator package for access Twitter API. category: Web stability: Experimental cabal-version: >= 1.8 build-type: Simple homepage: https://github.com/himura/twitter-types extra-source-files: README.md tests/fixtures/*.json source-repository head type: git location: git://github.com/himura/twitter-types.git flag time15 description: use time >= 1.5. default: True library ghc-options: -Wall build-depends: base >= 4 && < 5 , aeson >= 0.3.2.2 , text , unordered-containers if flag(time15) build-depends: time >= 1.5 else build-depends: time >= 1.2 && < 1.5 , old-locale if impl(ghc < 7.6) build-depends: ghc-prim exposed-modules: Web.Twitter.Types test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: TypesTest.hs build-depends: base >= 4.0 && < 5 , template-haskell , test-framework >= 0.3.3 , test-framework-hunit , test-framework-quickcheck2 , HUnit , QuickCheck , derive , aeson , attoparsec , bytestring , text , time , unordered-containers , filepath , directory , twitter-types , old-locale other-modules: Fixtures Instances ghc-options: -Wall twitter-types-0.7.2.2/README.md0000644000000000000000000000032012730546400014165 0ustar0000000000000000twitter-types ============= [![Build Status](https://secure.travis-ci.org/himura/twitter-types.png)](http://travis-ci.org/himura/twitter-types) This library treats the Twitter JSON API in the Haskell way. twitter-types-0.7.2.2/tests/fixtures/list_thimura_haskell.json0000644000000000000000000000351012730546400023027 0ustar0000000000000000{"id_str":"20849097","slug":"haskell","mode":"public","full_name":"@thimura/haskell","uri":"/thimura/haskell","following":true,"user":{"screen_name":"thimura","profile_banner_url":"https://pbs.twimg.com/profile_banners/69179963/1402419439","is_translation_enabled":false,"default_profile":false,"profile_image_url":"http://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","default_profile_image":false,"id_str":"69179963","profile_background_image_url_https":"https://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","protected":false,"location":"State# Irotoridori.No.World","entities":{"url":{"urls":[{"expanded_url":"http://d.hatena.ne.jp/thimura","url":"http://t.co/TFUAsAffX0","indices":[0,22],"display_url":"d.hatena.ne.jp/thimura"}]},"description":{"urls":[]}},"profile_background_color":"000000","utc_offset":32400,"url":"http://t.co/TFUAsAffX0","profile_text_color":"333333","profile_image_url_https":"https://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","verified":false,"statuses_count":24734,"profile_background_tile":true,"following":false,"lang":"en","follow_request_sent":false,"profile_sidebar_fill_color":"BABDD1","time_zone":"Tokyo","name":"ちむら","profile_sidebar_border_color":"FFFFFF","geo_enabled":false,"listed_count":102,"contributors_enabled":false,"created_at":"Thu Aug 27 02:48:06 +0000 2009","id":69179963,"friends_count":781,"is_translator":false,"favourites_count":17345,"notifications":false,"profile_background_image_url":"http://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","profile_use_background_image":true,"description":"真紅かわいい","profile_link_color":"00660F","followers_count":755},"member_count":50,"name":"haskell","created_at":"Sat Sep 04 11:48:02 +0000 2010","id":20849097,"subscriber_count":1,"description":""}twitter-types-0.7.2.2/tests/fixtures/media_extended_entity.json0000644000000000000000000001125412730546400023157 0ustar0000000000000000{"in_reply_to_status_id":null,"id_str":"479666034073296896","truncated":false,"possibly_sensitive":false,"in_reply_to_screen_name":null,"extended_entities":{"media":[{"id_str":"479665892922376192","expanded_url":"http://twitter.com/thimura_test/status/479666034073296896/photo/1","url":"http://t.co/qOjPwmgLKO","media_url_https":"https://pbs.twimg.com/media/BqgdlpaCQAA5OSu.jpg","indices":[36,58],"id":479665892922376192,"media_url":"http://pbs.twimg.com/media/BqgdlpaCQAA5OSu.jpg","type":"photo","sizes":{"small":{"w":340,"resize":"fit","h":604},"large":{"w":576,"resize":"fit","h":1024},"medium":{"w":576,"resize":"fit","h":1024},"thumb":{"w":150,"resize":"crop","h":150}},"display_url":"pic.twitter.com/qOjPwmgLKO"},{"id_str":"479665897150234624","expanded_url":"http://twitter.com/thimura_test/status/479666034073296896/photo/1","url":"http://t.co/qOjPwmgLKO","media_url_https":"https://pbs.twimg.com/media/Bqgdl5KCQAA9g9V.jpg","indices":[36,58],"id":479665897150234624,"media_url":"http://pbs.twimg.com/media/Bqgdl5KCQAA9g9V.jpg","type":"photo","sizes":{"small":{"w":339,"resize":"fit","h":191},"large":{"w":1024,"resize":"fit","h":576},"medium":{"w":599,"resize":"fit","h":337},"thumb":{"w":150,"resize":"crop","h":150}},"display_url":"pic.twitter.com/qOjPwmgLKO"},{"id_str":"479665901545852929","expanded_url":"http://twitter.com/thimura_test/status/479666034073296896/photo/1","url":"http://t.co/qOjPwmgLKO","media_url_https":"https://pbs.twimg.com/media/BqgdmJiCEAEp0EI.jpg","indices":[36,58],"id":479665901545852929,"media_url":"http://pbs.twimg.com/media/BqgdmJiCEAEp0EI.jpg","type":"photo","sizes":{"small":{"w":339,"resize":"fit","h":225},"large":{"w":1024,"resize":"fit","h":678},"medium":{"w":599,"resize":"fit","h":397},"thumb":{"w":150,"resize":"crop","h":150}},"display_url":"pic.twitter.com/qOjPwmgLKO"},{"id_str":"479665905375256576","expanded_url":"http://twitter.com/thimura_test/status/479666034073296896/photo/1","url":"http://t.co/qOjPwmgLKO","media_url_https":"https://pbs.twimg.com/media/BqgdmXzCIAAa2lU.jpg","indices":[36,58],"id":479665905375256576,"media_url":"http://pbs.twimg.com/media/BqgdmXzCIAAa2lU.jpg","type":"photo","sizes":{"small":{"w":339,"resize":"fit","h":225},"large":{"w":1024,"resize":"fit","h":678},"medium":{"w":599,"resize":"fit","h":397},"thumb":{"w":150,"resize":"crop","h":150}},"display_url":"pic.twitter.com/qOjPwmgLKO"}]},"entities":{"symbols":[],"urls":[],"media":[{"id_str":"479665892922376192","expanded_url":"http://twitter.com/thimura_test/status/479666034073296896/photo/1","url":"http://t.co/qOjPwmgLKO","media_url_https":"https://pbs.twimg.com/media/BqgdlpaCQAA5OSu.jpg","indices":[36,58],"id":479665892922376192,"media_url":"http://pbs.twimg.com/media/BqgdlpaCQAA5OSu.jpg","type":"photo","sizes":{"small":{"w":340,"resize":"fit","h":604},"large":{"w":576,"resize":"fit","h":1024},"medium":{"w":576,"resize":"fit","h":1024},"thumb":{"w":150,"resize":"crop","h":150}},"display_url":"pic.twitter.com/qOjPwmgLKO"}],"user_mentions":[],"hashtags":[{"text":"testnyan","indices":[26,35]}]},"text":"multiple image tweet test #testnyan http://t.co/qOjPwmgLKO","in_reply_to_user_id_str":null,"favorited":false,"coordinates":null,"retweeted":false,"user":{"screen_name":"thimura_test","is_translation_enabled":false,"default_profile":true,"profile_image_url":"http://abs.twimg.com/sticky/default_profile_images/default_profile_6_normal.png","default_profile_image":true,"id_str":"2418883074","profile_background_image_url_https":"https://abs.twimg.com/images/themes/theme1/bg.png","protected":false,"location":"","entities":{"description":{"urls":[]}},"profile_background_color":"C0DEED","utc_offset":null,"url":null,"profile_text_color":"333333","profile_image_url_https":"https://abs.twimg.com/sticky/default_profile_images/default_profile_6_normal.png","verified":false,"statuses_count":5,"profile_background_tile":false,"following":false,"lang":"ja","follow_request_sent":false,"profile_sidebar_fill_color":"DDEEF6","time_zone":null,"name":"thimura test","profile_sidebar_border_color":"C0DEED","geo_enabled":false,"listed_count":0,"contributors_enabled":false,"created_at":"Sun Mar 30 11:47:17 +0000 2014","id":2418883074,"friends_count":2,"is_translator":false,"favourites_count":0,"notifications":false,"profile_background_image_url":"http://abs.twimg.com/images/themes/theme1/bg.png","profile_use_background_image":true,"description":"","profile_link_color":"0084B4","followers_count":2},"lang":"et","retweet_count":0,"in_reply_to_user_id":null,"created_at":"Thu Jun 19 16:44:28 +0000 2014","source":"\u003ca href=\"https://twitter.com/thimura\" rel=\"nofollow\"\u003e二階堂真紅\u003c/a\u003e","geo":null,"id":479666034073296896,"in_reply_to_status_id_str":null,"favorite_count":0,"contributors":null,"place":null} twitter-types-0.7.2.2/tests/fixtures/error_not_authorized.json0000644000000000000000000000011112730546400023061 0ustar0000000000000000{"request":"\/1\/statuses\/user_timeline.json","error":"Not authorized"} twitter-types-0.7.2.2/tests/fixtures/user_thimura.json0000644000000000000000000000433712730546400021337 0ustar0000000000000000{"screen_name":"thimura","profile_banner_url":"https://pbs.twimg.com/profile_banners/69179963/1402419439","status":{"in_reply_to_status_id":null,"id_str":"495192122836783104","truncated":false,"in_reply_to_screen_name":null,"entities":{"symbols":[],"urls":[],"user_mentions":[],"hashtags":[]},"text":"くそあつい","in_reply_to_user_id_str":null,"favorited":false,"coordinates":null,"retweeted":false,"lang":"ja","retweet_count":0,"in_reply_to_user_id":null,"created_at":"Fri Aug 01 12:59:36 +0000 2014","source":"\u003ca href=\"http://twitter.com\" rel=\"nofollow\"\u003eTwitter Web Client\u003c/a\u003e","geo":null,"id":495192122836783104,"in_reply_to_status_id_str":null,"favorite_count":0,"contributors":null,"place":null},"is_translation_enabled":false,"needs_phone_verification":false,"default_profile":false,"profile_image_url":"http://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","default_profile_image":false,"id_str":"69179963","profile_background_image_url_https":"https://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","protected":false,"location":"State# Irotoridori.No.World","entities":{"url":{"urls":[{"expanded_url":"http://d.hatena.ne.jp/thimura","url":"http://t.co/TFUAsAffX0","indices":[0,22],"display_url":"d.hatena.ne.jp/thimura"}]},"description":{"urls":[]}},"profile_background_color":"000000","utc_offset":32400,"url":"http://t.co/TFUAsAffX0","profile_text_color":"333333","profile_image_url_https":"https://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","suspended":false,"verified":false,"statuses_count":24709,"profile_background_tile":true,"following":false,"lang":"en","follow_request_sent":false,"profile_sidebar_fill_color":"BABDD1","time_zone":"Tokyo","name":"ちむら","profile_sidebar_border_color":"FFFFFF","geo_enabled":false,"listed_count":102,"contributors_enabled":false,"created_at":"Thu Aug 27 02:48:06 +0000 2009","id":69179963,"friends_count":780,"is_translator":false,"favourites_count":17313,"notifications":false,"profile_background_image_url":"http://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","profile_use_background_image":true,"description":"真紅かわいい","profile_link_color":"00660F","followers_count":754}twitter-types-0.7.2.2/tests/fixtures/media_entity.json0000644000000000000000000000440312730546400021275 0ustar0000000000000000{"created_at":"Wed Sep 14 20:58:04 +0000 2011","id":114080493036773378,"id_str":"114080493036773378","text":"Hello America! http:\/\/t.co\/rJC5Pxsu","source":"web","truncated":false,"in_reply_to_status_id":null,"in_reply_to_status_id_str":null,"in_reply_to_user_id":null,"in_reply_to_user_id_str":null,"in_reply_to_screen_name":null,"user":{"id":373487136,"id_str":"373487136","name":"Y U No @rno?","screen_name":"yunorno","location":"Paris, France","url":"http:\/\/twitter.com\/rno","description":"Oui oui!","protected":false,"followers_count":32,"friends_count":3,"listed_count":2,"created_at":"Wed Sep 14 17:24:54 +0000 2011","favourites_count":0,"utc_offset":null,"time_zone":null,"geo_enabled":false,"verified":false,"statuses_count":27,"lang":"en","contributors_enabled":false,"is_translator":false,"profile_background_color":"C0DEED","profile_background_image_url":"http:\/\/a0.twimg.com\/images\/themes\/theme1\/bg.png","profile_background_image_url_https":"https:\/\/si0.twimg.com\/images\/themes\/theme1\/bg.png","profile_background_tile":false,"profile_image_url":"http:\/\/a0.twimg.com\/profile_images\/1542800106\/oui_normal.png","profile_image_url_https":"https:\/\/si0.twimg.com\/profile_images\/1542800106\/oui_normal.png","profile_link_color":"0084B4","profile_sidebar_border_color":"C0DEED","profile_sidebar_fill_color":"DDEEF6","profile_text_color":"333333","profile_use_background_image":true,"default_profile":true,"default_profile_image":false,"following":false,"follow_request_sent":false,"notifications":false},"geo":null,"coordinates":null,"place":null,"contributors":null,"retweet_count":4,"entities":{"hashtags":[],"urls":[],"user_mentions":[],"media":[{"id":114080493040967680,"id_str":"114080493040967680","indices":[15,35],"media_url":"http:\/\/pbs.twimg.com\/media\/AZVLmp-CIAAbkyy.jpg","media_url_https":"https:\/\/pbs.twimg.com\/media\/AZVLmp-CIAAbkyy.jpg","url":"http:\/\/t.co\/rJC5Pxsu","display_url":"pic.twitter.com\/rJC5Pxsu","expanded_url":"http:\/\/twitter.com\/yunorno\/status\/114080493036773378\/photo\/1","type":"photo","sizes":{"large":{"w":226,"h":238,"resize":"fit"},"thumb":{"w":150,"h":150,"resize":"crop"},"medium":{"w":226,"h":238,"resize":"fit"},"small":{"w":226,"h":238,"resize":"fit"}}}]},"favorited":false,"retweeted":false,"possibly_sensitive":false} twitter-types-0.7.2.2/tests/fixtures/event_favorite_thimura.json0000644000000000000000000001157712730546400023405 0ustar0000000000000000{"event":"favorite","created_at":"Sat Aug 02 16:32:01 +0000 2014","source":{"id":2566877347,"id_str":"2566877347","name":"thimura shinku","screen_name":"thimura_shinku","location":null,"url":null,"description":"\u4e8c\u968e\u5802 \u771f\u7d05","protected":false,"followers_count":4,"friends_count":3,"listed_count":0,"created_at":"Sat Jun 14 10:15:19 +0000 2014","favourites_count":2,"utc_offset":32400,"time_zone":"Irkutsk","geo_enabled":false,"verified":false,"statuses_count":1,"lang":"ja","contributors_enabled":false,"is_translator":false,"is_translation_enabled":false,"profile_background_color":"C0DEED","profile_background_image_url":"http:\/\/abs.twimg.com\/images\/themes\/theme1\/bg.png","profile_background_image_url_https":"https:\/\/abs.twimg.com\/images\/themes\/theme1\/bg.png","profile_background_tile":false,"profile_image_url":"http:\/\/pbs.twimg.com\/profile_images\/477757821895704577\/rVwTwORU_normal.jpeg","profile_image_url_https":"https:\/\/pbs.twimg.com\/profile_images\/477757821895704577\/rVwTwORU_normal.jpeg","profile_banner_url":"https:\/\/pbs.twimg.com\/profile_banners\/2566877347\/1402741935","profile_link_color":"0084B4","profile_sidebar_border_color":"C0DEED","profile_sidebar_fill_color":"DDEEF6","profile_text_color":"333333","profile_use_background_image":true,"default_profile":true,"default_profile_image":false,"following":null,"follow_request_sent":null,"notifications":null},"target":{"id":69179963,"id_str":"69179963","name":"\u3061\u3080\u3089","screen_name":"thimura","location":"State# Irotoridori.No.World","url":"http:\/\/d.hatena.ne.jp\/thimura","description":"\u771f\u7d05\u304b\u308f\u3044\u3044","protected":false,"followers_count":755,"friends_count":781,"listed_count":102,"created_at":"Thu Aug 27 02:48:06 +0000 2009","favourites_count":17363,"utc_offset":32400,"time_zone":"Tokyo","geo_enabled":false,"verified":false,"statuses_count":24747,"lang":"en","contributors_enabled":false,"is_translator":false,"is_translation_enabled":false,"profile_background_color":"000000","profile_background_image_url":"http:\/\/pbs.twimg.com\/profile_background_images\/378800000154132099\/hn0DlU5i.png","profile_background_image_url_https":"https:\/\/pbs.twimg.com\/profile_background_images\/378800000154132099\/hn0DlU5i.png","profile_background_tile":true,"profile_image_url":"http:\/\/pbs.twimg.com\/profile_images\/414044387346116609\/VNMfLpY7_normal.png","profile_image_url_https":"https:\/\/pbs.twimg.com\/profile_images\/414044387346116609\/VNMfLpY7_normal.png","profile_banner_url":"https:\/\/pbs.twimg.com\/profile_banners\/69179963\/1402419439","profile_link_color":"00660F","profile_sidebar_border_color":"FFFFFF","profile_sidebar_fill_color":"BABDD1","profile_text_color":"333333","profile_use_background_image":true,"default_profile":false,"default_profile_image":false,"following":null,"follow_request_sent":null,"notifications":null},"target_object":{"created_at":"Sat Aug 02 15:49:45 +0000 2014","id":495597326736449536,"id_str":"495597326736449536","text":"haskell","source":"\u003ca href=\"http:\/\/twitter.com\" rel=\"nofollow\"\u003eTwitter Web Client\u003c\/a\u003e","truncated":false,"in_reply_to_status_id":null,"in_reply_to_status_id_str":null,"in_reply_to_user_id":null,"in_reply_to_user_id_str":null,"in_reply_to_screen_name":null,"user":{"id":69179963,"id_str":"69179963","name":"\u3061\u3080\u3089","screen_name":"thimura","location":"State# Irotoridori.No.World","url":"http:\/\/d.hatena.ne.jp\/thimura","description":"\u771f\u7d05\u304b\u308f\u3044\u3044","protected":false,"followers_count":755,"friends_count":781,"listed_count":102,"created_at":"Thu Aug 27 02:48:06 +0000 2009","favourites_count":17363,"utc_offset":32400,"time_zone":"Tokyo","geo_enabled":false,"verified":false,"statuses_count":24747,"lang":"en","contributors_enabled":false,"is_translator":false,"is_translation_enabled":false,"profile_background_color":"000000","profile_background_image_url":"http:\/\/pbs.twimg.com\/profile_background_images\/378800000154132099\/hn0DlU5i.png","profile_background_image_url_https":"https:\/\/pbs.twimg.com\/profile_background_images\/378800000154132099\/hn0DlU5i.png","profile_background_tile":true,"profile_image_url":"http:\/\/pbs.twimg.com\/profile_images\/414044387346116609\/VNMfLpY7_normal.png","profile_image_url_https":"https:\/\/pbs.twimg.com\/profile_images\/414044387346116609\/VNMfLpY7_normal.png","profile_banner_url":"https:\/\/pbs.twimg.com\/profile_banners\/69179963\/1402419439","profile_link_color":"00660F","profile_sidebar_border_color":"FFFFFF","profile_sidebar_fill_color":"BABDD1","profile_text_color":"333333","profile_use_background_image":true,"default_profile":false,"default_profile_image":false,"following":null,"follow_request_sent":null,"notifications":null},"geo":null,"coordinates":null,"place":null,"contributors":null,"retweet_count":0,"favorite_count":2,"entities":{"hashtags":[],"symbols":[],"urls":[],"user_mentions":[]},"favorited":false,"retweeted":false,"lang":"en"}} twitter-types-0.7.2.2/tests/fixtures/entity01.json0000644000000000000000000000054012730546400020275 0ustar0000000000000000{"symbols":[],"urls":[{"indices":[32,52], "url":"http://t.co/IOwBrTZR", "display_url":"youtube.com/watch?v=oHg5SJ\u2026", "expanded_url":"http://www.youtube.com/watch?v=oHg5SJYRHA0"}],"user_mentions":[{"name":"Twitter API", "indices":[4,15], "screen_name":"twitterapi", "id":6253282, "id_str":"6253282"}],"hashtags":[{"indices":[32,36],"text":"lol"}]} twitter-types-0.7.2.2/tests/fixtures/status_with_entity.json0000644000000000000000000000464612730546400022605 0ustar0000000000000000{"created_at":"Sat Sep 10 22:23:38 +0000 2011","id":112652479837110273,"id_str":"112652479837110273","text":"@twitter meets @seepicturely at #tcdisrupt cc.@boscomonkey @episod http:\/\/t.co\/6J2EgYM","source":"\u003ca href=\"http:\/\/instagr.am\" rel=\"nofollow\"\u003eInstagram\u003c\/a\u003e","truncated":false,"in_reply_to_status_id":null,"in_reply_to_status_id_str":null,"in_reply_to_user_id":783214,"in_reply_to_user_id_str":"783214","in_reply_to_screen_name":"twitter","user":{"id":299862462,"id_str":"299862462","name":"Eoin McMillan ","screen_name":"imeoin","location":"Twitter","description":"Eoin's photography account. See @mceoin for tweets.","url":"http:\/\/www.eoin.me","protected":false,"followers_count":6,"friends_count":0,"listed_count":0,"created_at":"Mon May 16 20:07:59 +0000 2011","favourites_count":0,"utc_offset":null,"time_zone":null,"geo_enabled":false,"verified":false,"statuses_count":277,"lang":"en","contributors_enabled":false,"is_translator":false,"profile_background_color":"131516","profile_background_image_url":"http:\/\/a0.twimg.com\/images\/themes\/theme14\/bg.gif","profile_background_image_url_https":"https:\/\/si0.twimg.com\/images\/themes\/theme14\/bg.gif","profile_background_tile":true,"profile_image_url":"http:\/\/a0.twimg.com\/profile_images\/1380912173\/Screen_shot_2011-06-03_at_7.35.36_PM_normal.png","profile_image_url_https":"https:\/\/si0.twimg.com\/profile_images\/1380912173\/Screen_shot_2011-06-03_at_7.35.36_PM_normal.png","profile_link_color":"009999","profile_sidebar_border_color":"EEEEEE","profile_sidebar_fill_color":"EFEFEF","profile_text_color":"333333","profile_use_background_image":true,"show_all_inline_media":false,"default_profile":false,"default_profile_image":false,"following":null,"follow_request_sent":null,"notifications":null},"geo":null,"coordinates":null,"place":null,"contributors":null,"retweet_count":0,"entities":{"hashtags":[{"text":"tcdisrupt","indices":[32,42]}],"urls":[{"url":"http:\/\/t.co\/6J2EgYM","expanded_url":"http:\/\/instagr.am\/p\/MuW67\/","display_url":"instagr.am\/p\/MuW67\/","indices":[67,86]}],"user_mentions":[{"screen_name":"twitter","name":"Twitter","id":783214,"id_str":"783214","indices":[0,8]},{"screen_name":"boscomonkey","name":"Bosco So","id":14792670,"id_str":"14792670","indices":[46,58]},{"screen_name":"episod","name":"Taylor Singletary","id":819797,"id_str":"819797","indices":[59,66]}]},"favorited":false,"retweeted":false,"possibly_sensitive":false} twitter-types-0.7.2.2/tests/fixtures/status_quoted.json0000644000000000000000000001477312730546400021541 0ustar0000000000000000{ "created_at": "Wed Sep 09 17:13:42 +0000 2015", "id": 641660763770372100, "id_str": "641660763770372097", "text": "Wow! Congrats! https://t.co/EPMMldEcci", "source": "Twitter for iPhone", "truncated": false, "in_reply_to_status_id": null, "in_reply_to_status_id_str": null, "in_reply_to_user_id": null, "in_reply_to_user_id_str": null, "in_reply_to_screen_name": null, "user": { "id": 15232432, "id_str": "15232432", "name": "Dean Wampler", "screen_name": "deanwampler", "location": "Chicago", "description": "Minor irritant, major pedant, Big Data, IoT, and Scala poser. Lurks at Typesafe. O'Reilly author. Opinions are my own..", "url": "http://t.co/bzGTwCnmvO", "entities": { "url": { "urls": [ { "url": "http://t.co/bzGTwCnmvO", "expanded_url": "http://typesafe.com", "display_url": "typesafe.com", "indices": [ 0, 22 ] } ] }, "description": { "urls": [] } }, "protected": false, "followers_count": 7221, "friends_count": 811, "listed_count": 645, "created_at": "Wed Jun 25 15:24:31 +0000 2008", "favourites_count": 2841, "utc_offset": -18000, "time_zone": "Central Time (US & Canada)", "geo_enabled": true, "verified": false, "statuses_count": 13483, "lang": "en", "contributors_enabled": false, "is_translator": false, "is_translation_enabled": false, "profile_background_color": "9AE4E8", "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/670120165/5514a5b016bf4d3d617ece5f117643d0.jpeg", "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/670120165/5514a5b016bf4d3d617ece5f117643d0.jpeg", "profile_background_tile": true, "profile_image_url": "http://pbs.twimg.com/profile_images/639619926374748160/QhODNcWz_normal.jpg", "profile_image_url_https": "https://pbs.twimg.com/profile_images/639619926374748160/QhODNcWz_normal.jpg", "profile_banner_url": "https://pbs.twimg.com/profile_banners/15232432/1359038744", "profile_link_color": "0000FF", "profile_sidebar_border_color": "FFFFFF", "profile_sidebar_fill_color": "DFF8A0", "profile_text_color": "070708", "profile_use_background_image": true, "has_extended_profile": false, "default_profile": false, "default_profile_image": false, "following": false, "follow_request_sent": false, "notifications": false }, "geo": null, "coordinates": null, "place": null, "contributors": null, "quoted_status_id": 641653574284537900, "quoted_status_id_str": "641653574284537856", "quoted_status": { "created_at": "Wed Sep 09 16:45:08 +0000 2015", "id": 641653574284537900, "id_str": "641653574284537856", "text": "Very happy to say that I'm joining @mesosphere as a Distributed Systems Engineer!", "source": "Twitter Web Client", "truncated": false, "in_reply_to_status_id": null, "in_reply_to_status_id_str": null, "in_reply_to_user_id": null, "in_reply_to_user_id_str": null, "in_reply_to_screen_name": null, "user": { "id": 54129186, "id_str": "54129186", "name": "Neil Conway", "screen_name": "neil_conway", "location": "Oakland, CA", "description": "Large-scale data management and distributed systems.", "url": "http://t.co/grthxRo5Q1", "entities": { "url": { "urls": [ { "url": "http://t.co/grthxRo5Q1", "expanded_url": "http://neilconway.org", "display_url": "neilconway.org", "indices": [ 0, 22 ] } ] }, "description": { "urls": [] } }, "protected": false, "followers_count": 3380, "friends_count": 680, "listed_count": 202, "created_at": "Mon Jul 06 05:43:15 +0000 2009", "favourites_count": 611, "utc_offset": -25200, "time_zone": "Pacific Time (US & Canada)", "geo_enabled": true, "verified": false, "statuses_count": 3559, "lang": "en", "contributors_enabled": false, "is_translator": false, "is_translation_enabled": false, "profile_background_color": "FFFFFF", "profile_background_image_url": "http://pbs.twimg.com/profile_background_images/204823473/Untitled-2.jpg", "profile_background_image_url_https": "https://pbs.twimg.com/profile_background_images/204823473/Untitled-2.jpg", "profile_background_tile": true, "profile_image_url": "http://pbs.twimg.com/profile_images/299445365/3613789225_66f1cc848f_b_normal.jpg", "profile_image_url_https": "https://pbs.twimg.com/profile_images/299445365/3613789225_66f1cc848f_b_normal.jpg", "profile_link_color": "036E6E", "profile_sidebar_border_color": "B05607", "profile_sidebar_fill_color": "E8F0F0", "profile_text_color": "998308", "profile_use_background_image": true, "has_extended_profile": false, "default_profile": false, "default_profile_image": false, "following": true, "follow_request_sent": false, "notifications": false }, "geo": null, "coordinates": null, "place": null, "contributors": null, "is_quote_status": false, "retweet_count": 7, "favorite_count": 63, "entities": { "hashtags": [], "symbols": [], "user_mentions": [ { "screen_name": "mesosphere", "name": "Mesosphere", "id": 1872399366, "id_str": "1872399366", "indices": [ 35, 46 ] } ], "urls": [] }, "favorited": false, "retweeted": false, "lang": "en" }, "is_quote_status": true, "retweet_count": 0, "favorite_count": 1, "entities": { "hashtags": [], "symbols": [], "user_mentions": [], "urls": [ { "url": "https://t.co/EPMMldEcci", "expanded_url": "https://twitter.com/neil_conway/status/641653574284537856", "display_url": "twitter.com/neil_conway/st…", "indices": [ 15, 38 ] } ] }, "favorited": false, "retweeted": false, "possibly_sensitive": false, "possibly_sensitive_appealable": false, "lang": "en" } twitter-types-0.7.2.2/tests/fixtures/status01.json0000644000000000000000000000363612730546400020315 0ustar0000000000000000{"created_at":"Sat Sep 10 22:23:38 +0000 2011","id":112652479837110273,"id_str":"112652479837110273","text":"@twitter meets @seepicturely at #tcdisrupt cc.@boscomonkey @episod http:\/\/t.co\/6J2EgYM","source":"\u003ca href=\"http:\/\/instagr.am\" rel=\"nofollow\"\u003eInstagram\u003c\/a\u003e","truncated":false,"in_reply_to_status_id":null,"in_reply_to_status_id_str":null,"in_reply_to_user_id":783214,"in_reply_to_user_id_str":"783214","in_reply_to_screen_name":"twitter","user":{"id":299862462,"id_str":"299862462","name":"Eoin McMillan ","screen_name":"imeoin","location":"Twitter","description":"Eoin's photography account. See @mceoin for tweets.","url":"http:\/\/www.eoin.me","protected":false,"followers_count":6,"friends_count":0,"listed_count":0,"created_at":"Mon May 16 20:07:59 +0000 2011","favourites_count":0,"utc_offset":null,"time_zone":null,"geo_enabled":false,"verified":false,"statuses_count":277,"lang":"en","contributors_enabled":false,"is_translator":false,"profile_background_color":"131516","profile_background_image_url":"http:\/\/a0.twimg.com\/images\/themes\/theme14\/bg.gif","profile_background_image_url_https":"https:\/\/si0.twimg.com\/images\/themes\/theme14\/bg.gif","profile_background_tile":true,"profile_image_url":"http:\/\/a0.twimg.com\/profile_images\/1380912173\/Screen_shot_2011-06-03_at_7.35.36_PM_normal.png","profile_image_url_https":"https:\/\/si0.twimg.com\/profile_images\/1380912173\/Screen_shot_2011-06-03_at_7.35.36_PM_normal.png","profile_link_color":"009999","profile_sidebar_border_color":"EEEEEE","profile_sidebar_fill_color":"EFEFEF","profile_text_color":"333333","profile_use_background_image":true,"show_all_inline_media":false,"default_profile":false,"default_profile_image":false,"following":null,"follow_request_sent":null,"notifications":null},"geo":null,"coordinates":null,"place":null,"contributors":null,"retweet_count":0,"favorited":false,"retweeted":false,"possibly_sensitive":false} twitter-types-0.7.2.2/tests/fixtures/direct_message_thimura.json0000644000000000000000000000655012730546400023336 0ustar0000000000000000{"id_str":"495602442466123776","entities":{"symbols":[],"urls":[],"user_mentions":[],"hashtags":[]},"text":"おまえの明日が、今日よりもずっと、楽しい事で溢れているようにと、祈っているよ","sender_screen_name":"thimura_shinku","sender":{"screen_name":"thimura_shinku","profile_banner_url":"https://pbs.twimg.com/profile_banners/2566877347/1402741935","is_translation_enabled":false,"default_profile":true,"profile_image_url":"http://pbs.twimg.com/profile_images/477757821895704577/rVwTwORU_normal.jpeg","default_profile_image":false,"id_str":"2566877347","profile_background_image_url_https":"https://abs.twimg.com/images/themes/theme1/bg.png","protected":false,"location":"","entities":{"description":{"urls":[]}},"profile_background_color":"C0DEED","utc_offset":32400,"url":null,"profile_text_color":"333333","profile_image_url_https":"https://pbs.twimg.com/profile_images/477757821895704577/rVwTwORU_normal.jpeg","verified":false,"statuses_count":1,"profile_background_tile":false,"following":true,"lang":"ja","follow_request_sent":false,"profile_sidebar_fill_color":"DDEEF6","time_zone":"Irkutsk","name":"thimura shinku","profile_sidebar_border_color":"C0DEED","geo_enabled":false,"listed_count":0,"contributors_enabled":false,"created_at":"Sat Jun 14 10:15:19 +0000 2014","id":2566877347,"friends_count":3,"is_translator":false,"favourites_count":1,"notifications":false,"profile_background_image_url":"http://abs.twimg.com/images/themes/theme1/bg.png","profile_use_background_image":true,"description":"二階堂 真紅","profile_link_color":"0084B4","followers_count":4},"sender_id_str":"2566877347","recipient_id":69179963,"created_at":"Sat Aug 02 16:10:04 +0000 2014","id":495602442466123776,"recipient_screen_name":"thimura","recipient_id_str":"69179963","recipient":{"screen_name":"thimura","profile_banner_url":"https://pbs.twimg.com/profile_banners/69179963/1402419439","is_translation_enabled":false,"default_profile":false,"profile_image_url":"http://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","default_profile_image":false,"id_str":"69179963","profile_background_image_url_https":"https://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","protected":false,"location":"State# Irotoridori.No.World","entities":{"url":{"urls":[{"expanded_url":"http://d.hatena.ne.jp/thimura","url":"http://t.co/TFUAsAffX0","indices":[0,22],"display_url":"d.hatena.ne.jp/thimura"}]},"description":{"urls":[]}},"profile_background_color":"000000","utc_offset":32400,"url":"http://t.co/TFUAsAffX0","profile_text_color":"333333","profile_image_url_https":"https://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","verified":false,"statuses_count":24747,"profile_background_tile":true,"following":false,"lang":"en","follow_request_sent":false,"profile_sidebar_fill_color":"BABDD1","time_zone":"Tokyo","name":"ちむら","profile_sidebar_border_color":"FFFFFF","geo_enabled":false,"listed_count":102,"contributors_enabled":false,"created_at":"Thu Aug 27 02:48:06 +0000 2009","id":69179963,"friends_count":781,"is_translator":false,"favourites_count":17362,"notifications":false,"profile_background_image_url":"http://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","profile_use_background_image":true,"description":"真紅かわいい","profile_link_color":"00660F","followers_count":755},"sender_id":2566877347}twitter-types-0.7.2.2/tests/fixtures/status_thimura_with_photo.json0000644000000000000000000000654212730546400024150 0ustar0000000000000000{"in_reply_to_status_id":null,"id_str":"491143410770657280","truncated":false,"possibly_sensitive":false,"in_reply_to_screen_name":null,"extended_entities":{"media":[{"id_str":"491143397378244610","expanded_url":"http://twitter.com/thimura/status/491143410770657280/photo/1","url":"http://t.co/FjSOU8dDoD","media_url_https":"https://pbs.twimg.com/media/BtDkUVaCQAIpWBU.jpg","indices":[7,29],"id":491143397378244610,"media_url":"http://pbs.twimg.com/media/BtDkUVaCQAIpWBU.jpg","type":"photo","sizes":{"small":{"w":340,"resize":"fit","h":191},"large":{"w":1024,"resize":"fit","h":576},"medium":{"w":600,"resize":"fit","h":338},"thumb":{"w":150,"resize":"crop","h":150}},"display_url":"pic.twitter.com/FjSOU8dDoD"}]},"entities":{"symbols":[],"urls":[],"media":[{"id_str":"491143397378244610","expanded_url":"http://twitter.com/thimura/status/491143410770657280/photo/1","url":"http://t.co/FjSOU8dDoD","media_url_https":"https://pbs.twimg.com/media/BtDkUVaCQAIpWBU.jpg","indices":[7,29],"id":491143397378244610,"media_url":"http://pbs.twimg.com/media/BtDkUVaCQAIpWBU.jpg","type":"photo","sizes":{"small":{"w":340,"resize":"fit","h":191},"large":{"w":1024,"resize":"fit","h":576},"medium":{"w":600,"resize":"fit","h":338},"thumb":{"w":150,"resize":"crop","h":150}},"display_url":"pic.twitter.com/FjSOU8dDoD"}],"user_mentions":[],"hashtags":[]},"text":"近所の海です http://t.co/FjSOU8dDoD","in_reply_to_user_id_str":null,"favorited":false,"coordinates":null,"retweeted":false,"user":{"screen_name":"thimura","profile_banner_url":"https://pbs.twimg.com/profile_banners/69179963/1402419439","is_translation_enabled":false,"default_profile":false,"profile_image_url":"http://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","default_profile_image":false,"id_str":"69179963","profile_background_image_url_https":"https://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","protected":false,"location":"State# Irotoridori.No.World","entities":{"url":{"urls":[{"expanded_url":"http://d.hatena.ne.jp/thimura","url":"http://t.co/TFUAsAffX0","indices":[0,22],"display_url":"d.hatena.ne.jp/thimura"}]},"description":{"urls":[]}},"profile_background_color":"000000","utc_offset":32400,"url":"http://t.co/TFUAsAffX0","profile_text_color":"333333","profile_image_url_https":"https://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","verified":false,"statuses_count":24734,"profile_background_tile":true,"following":false,"lang":"en","follow_request_sent":false,"profile_sidebar_fill_color":"BABDD1","time_zone":"Tokyo","name":"ちむら","profile_sidebar_border_color":"FFFFFF","geo_enabled":false,"listed_count":102,"contributors_enabled":false,"created_at":"Thu Aug 27 02:48:06 +0000 2009","id":69179963,"friends_count":781,"is_translator":false,"favourites_count":17345,"notifications":false,"profile_background_image_url":"http://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","profile_use_background_image":true,"description":"真紅かわいい","profile_link_color":"00660F","followers_count":755},"lang":"ja","retweet_count":4,"in_reply_to_user_id":null,"created_at":"Mon Jul 21 08:51:28 +0000 2014","source":"\u003ca href=\"https://sites.google.com/site/wakamesoba98/sobacha\" rel=\"nofollow\"\u003eSobaCha\u003c/a\u003e","geo":null,"id":491143410770657280,"in_reply_to_status_id_str":null,"favorite_count":9,"contributors":null,"place":null}twitter-types-0.7.2.2/tests/fixtures/search_haskell.json0000644000000000000000000000504512730546400021575 0ustar0000000000000000{"search_metadata":{"next_results":"?max_id=495594369802440705&q=haskell&include_entities=1","since_id_str":"0","completed_in":0.043,"count":1,"refresh_url":"?since_id=495597397733433345&q=haskell&include_entities=1","max_id_str":"495597397733433345","query":"haskell","since_id":0,"max_id":495597397733433345},"statuses":[{"in_reply_to_status_id":null,"id_str":"495597326736449536","truncated":false,"in_reply_to_screen_name":null,"entities":{"symbols":[],"urls":[],"user_mentions":[],"hashtags":[]},"text":"haskell","in_reply_to_user_id_str":null,"favorited":false,"coordinates":null,"retweeted":false,"user":{"screen_name":"thimura","profile_banner_url":"https://pbs.twimg.com/profile_banners/69179963/1402419439","is_translation_enabled":false,"default_profile":false,"profile_image_url":"http://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","default_profile_image":false,"id_str":"69179963","profile_background_image_url_https":"https://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","protected":false,"location":"State# Irotoridori.No.World","entities":{"url":{"urls":[{"expanded_url":"http://d.hatena.ne.jp/thimura","url":"http://t.co/TFUAsAffX0","indices":[0,22],"display_url":"d.hatena.ne.jp/thimura"}]},"description":{"urls":[]}},"profile_background_color":"000000","utc_offset":32400,"url":"http://t.co/TFUAsAffX0","profile_text_color":"333333","profile_image_url_https":"https://pbs.twimg.com/profile_images/414044387346116609/VNMfLpY7_normal.png","verified":false,"statuses_count":24747,"profile_background_tile":true,"following":false,"lang":"en","follow_request_sent":false,"profile_sidebar_fill_color":"BABDD1","time_zone":"Tokyo","name":"ちむら","profile_sidebar_border_color":"FFFFFF","geo_enabled":false,"listed_count":102,"contributors_enabled":false,"created_at":"Thu Aug 27 02:48:06 +0000 2009","id":69179963,"friends_count":781,"is_translator":false,"favourites_count":17362,"notifications":false,"profile_background_image_url":"http://pbs.twimg.com/profile_background_images/378800000154132099/hn0DlU5i.png","profile_use_background_image":true,"description":"真紅かわいい","profile_link_color":"00660F","followers_count":755},"lang":"et","retweet_count":0,"in_reply_to_user_id":null,"created_at":"Sat Aug 02 15:49:45 +0000 2014","metadata":{"result_type":"recent","iso_language_code":"et"},"source":"\u003ca href=\"http://twitter.com\" rel=\"nofollow\"\u003eTwitter Web Client\u003c/a\u003e","geo":null,"id":495597326736449536,"in_reply_to_status_id_str":null,"favorite_count":0,"contributors":null,"place":null}]} twitter-types-0.7.2.2/tests/fixtures/event_unfavorite_thimura.json0000644000000000000000000001160112730546400023734 0ustar0000000000000000{"event":"unfavorite","created_at":"Sat Aug 02 16:32:10 +0000 2014","source":{"id":2566877347,"id_str":"2566877347","name":"thimura shinku","screen_name":"thimura_shinku","location":null,"url":null,"description":"\u4e8c\u968e\u5802 \u771f\u7d05","protected":false,"followers_count":4,"friends_count":3,"listed_count":0,"created_at":"Sat Jun 14 10:15:19 +0000 2014","favourites_count":1,"utc_offset":32400,"time_zone":"Irkutsk","geo_enabled":false,"verified":false,"statuses_count":2,"lang":"ja","contributors_enabled":false,"is_translator":false,"is_translation_enabled":false,"profile_background_color":"C0DEED","profile_background_image_url":"http:\/\/abs.twimg.com\/images\/themes\/theme1\/bg.png","profile_background_image_url_https":"https:\/\/abs.twimg.com\/images\/themes\/theme1\/bg.png","profile_background_tile":false,"profile_image_url":"http:\/\/pbs.twimg.com\/profile_images\/477757821895704577\/rVwTwORU_normal.jpeg","profile_image_url_https":"https:\/\/pbs.twimg.com\/profile_images\/477757821895704577\/rVwTwORU_normal.jpeg","profile_banner_url":"https:\/\/pbs.twimg.com\/profile_banners\/2566877347\/1402741935","profile_link_color":"0084B4","profile_sidebar_border_color":"C0DEED","profile_sidebar_fill_color":"DDEEF6","profile_text_color":"333333","profile_use_background_image":true,"default_profile":true,"default_profile_image":false,"following":null,"follow_request_sent":null,"notifications":null},"target":{"id":69179963,"id_str":"69179963","name":"\u3061\u3080\u3089","screen_name":"thimura","location":"State# Irotoridori.No.World","url":"http:\/\/d.hatena.ne.jp\/thimura","description":"\u771f\u7d05\u304b\u308f\u3044\u3044","protected":false,"followers_count":755,"friends_count":781,"listed_count":102,"created_at":"Thu Aug 27 02:48:06 +0000 2009","favourites_count":17363,"utc_offset":32400,"time_zone":"Tokyo","geo_enabled":false,"verified":false,"statuses_count":24747,"lang":"en","contributors_enabled":false,"is_translator":false,"is_translation_enabled":false,"profile_background_color":"000000","profile_background_image_url":"http:\/\/pbs.twimg.com\/profile_background_images\/378800000154132099\/hn0DlU5i.png","profile_background_image_url_https":"https:\/\/pbs.twimg.com\/profile_background_images\/378800000154132099\/hn0DlU5i.png","profile_background_tile":true,"profile_image_url":"http:\/\/pbs.twimg.com\/profile_images\/414044387346116609\/VNMfLpY7_normal.png","profile_image_url_https":"https:\/\/pbs.twimg.com\/profile_images\/414044387346116609\/VNMfLpY7_normal.png","profile_banner_url":"https:\/\/pbs.twimg.com\/profile_banners\/69179963\/1402419439","profile_link_color":"00660F","profile_sidebar_border_color":"FFFFFF","profile_sidebar_fill_color":"BABDD1","profile_text_color":"333333","profile_use_background_image":true,"default_profile":false,"default_profile_image":false,"following":null,"follow_request_sent":null,"notifications":null},"target_object":{"created_at":"Sat Aug 02 15:49:45 +0000 2014","id":495597326736449536,"id_str":"495597326736449536","text":"haskell","source":"\u003ca href=\"http:\/\/twitter.com\" rel=\"nofollow\"\u003eTwitter Web Client\u003c\/a\u003e","truncated":false,"in_reply_to_status_id":null,"in_reply_to_status_id_str":null,"in_reply_to_user_id":null,"in_reply_to_user_id_str":null,"in_reply_to_screen_name":null,"user":{"id":69179963,"id_str":"69179963","name":"\u3061\u3080\u3089","screen_name":"thimura","location":"State# Irotoridori.No.World","url":"http:\/\/d.hatena.ne.jp\/thimura","description":"\u771f\u7d05\u304b\u308f\u3044\u3044","protected":false,"followers_count":755,"friends_count":781,"listed_count":102,"created_at":"Thu Aug 27 02:48:06 +0000 2009","favourites_count":17363,"utc_offset":32400,"time_zone":"Tokyo","geo_enabled":false,"verified":false,"statuses_count":24747,"lang":"en","contributors_enabled":false,"is_translator":false,"is_translation_enabled":false,"profile_background_color":"000000","profile_background_image_url":"http:\/\/pbs.twimg.com\/profile_background_images\/378800000154132099\/hn0DlU5i.png","profile_background_image_url_https":"https:\/\/pbs.twimg.com\/profile_background_images\/378800000154132099\/hn0DlU5i.png","profile_background_tile":true,"profile_image_url":"http:\/\/pbs.twimg.com\/profile_images\/414044387346116609\/VNMfLpY7_normal.png","profile_image_url_https":"https:\/\/pbs.twimg.com\/profile_images\/414044387346116609\/VNMfLpY7_normal.png","profile_banner_url":"https:\/\/pbs.twimg.com\/profile_banners\/69179963\/1402419439","profile_link_color":"00660F","profile_sidebar_border_color":"FFFFFF","profile_sidebar_fill_color":"BABDD1","profile_text_color":"333333","profile_use_background_image":true,"default_profile":false,"default_profile_image":false,"following":null,"follow_request_sent":null,"notifications":null},"geo":null,"coordinates":null,"place":null,"contributors":null,"retweet_count":1,"favorite_count":1,"entities":{"hashtags":[],"symbols":[],"urls":[],"user_mentions":[]},"favorited":false,"retweeted":false,"lang":"en"}} twitter-types-0.7.2.2/tests/fixtures/delete.json0000644000000000000000000000017612730546400020067 0ustar0000000000000000{"delete":{"status":{"id":495607981833064448,"user_id":2566877347,"id_str":"495607981833064448","user_id_str":"2566877347"}}}