diff --git a/Web/Twitter/Types.hs b/Web/Twitter/Types.hs --- a/Web/Twitter/Types.hs +++ b/Web/Twitter/Types.hs @@ -39,7 +39,6 @@ where import Control.Applicative -import Control.Monad import Data.Aeson import Data.Aeson.Types (Parser) import Data.Data @@ -105,7 +104,7 @@ where js :: FromJSON a => Parser a js = parseJSON v - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse StreamingAPI from: " ++ show v instance ToJSON StreamingAPI where toJSON (SStatus s) = toJSON s @@ -121,7 +120,7 @@ { statusContributors :: Maybe [Contributor] , statusCoordinates :: Maybe Coordinates , statusCreatedAt :: UTCTime - , statusCurrentUserRetweet :: Maybe UserId + , statusCurrentUserRetweet :: Maybe StatusId , statusEntities :: Maybe Entities , statusExtendedEntities :: Maybe Entities , statusFavoriteCount :: Integer @@ -135,6 +134,8 @@ , statusPlace :: Maybe Place , statusPossiblySensitive :: Maybe Bool , statusScopes :: Maybe Object + , statusQuotedStatusId :: Maybe StatusId + , statusQuotedStatus :: Maybe Status , statusRetweetCount :: Integer , statusRetweeted :: Maybe Bool , statusRetweetedStatus :: Maybe Status @@ -166,6 +167,8 @@ <*> o .:? "place" <*> o .:? "possibly_sensitive" <*> o .:? "scopes" + <*> o .:? "quoted_status_id" + <*> o .:? "quoted_status" <*> o .:? "retweet_count" .!= 0 <*> o .:? "retweeted" <*> o .:? "retweeted_status" @@ -176,7 +179,7 @@ <*> o .:? "withheld_copyright" <*> o .:? "withheld_in_countries" <*> o .:? "withheld_scope" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse status from: " ++ show v instance ToJSON Status where toJSON Status{..} = object [ "contributors" .= statusContributors @@ -198,6 +201,8 @@ , "place" .= statusPlace , "possibly_sensitive" .= statusPossiblySensitive , "scopes" .= statusScopes + , "quoted_status_id" .= statusQuotedStatusId + , "quoted_status" .= statusQuotedStatus , "retweet_count" .= statusRetweetCount , "retweeted" .= statusRetweeted , "retweeted_status" .= statusRetweetedStatus @@ -221,7 +226,7 @@ parseJSON (Object o) = checkError o >> SearchResult <$> o .: "statuses" <*> o .: "search_metadata" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse search result from: " ++ show v instance ToJSON body => ToJSON (SearchResult body) where @@ -247,7 +252,7 @@ <*> o .: "source" <*> o .: "user" <*> o .:? "coordinates" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse status search result from: " ++ show v instance ToJSON SearchStatus where toJSON SearchStatus{..} = object [ "created_at" .= TwitterTime searchStatusCreatedAt @@ -282,7 +287,7 @@ <*> o .: "since_id_str" <*> o .: "query" <*> o .: "max_id_str" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse search metadata from: " ++ show v instance ToJSON SearchMetadata where toJSON SearchMetadata{..} = object [ "max_id" .= searchMetadataMaxId @@ -320,7 +325,7 @@ <*> o .: "user" <*> o .: "retweeted_status" <*> o .:? "coordinates" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse retweeted status from: " ++ show v instance ToJSON RetweetedStatus where toJSON RetweetedStatus{..} = object [ "created_at" .= TwitterTime rsCreatedAt @@ -360,7 +365,7 @@ <*> o .: "recipient_id" <*> o .: "sender_id" <*> o .:? "coordinates" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse direct message from: " ++ show v instance ToJSON DirectMessage where toJSON DirectMessage{..} = object [ "created_at" .= TwitterTime dmCreatedAt @@ -389,7 +394,7 @@ ETStatus <$> parseJSON v <|> ETList <$> parseJSON v <|> return (ETUnknown v) - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse event target from: " ++ show v instance ToJSON EventTarget where toJSON (ETUser u) = toJSON u @@ -413,7 +418,7 @@ <*> o .: "event" <*> o .: "target" <*> o .: "source" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse event from: " ++ show v instance ToJSON Event where toJSON Event{..} = object [ "created_at" .= TwitterTime evCreatedAt @@ -434,7 +439,7 @@ s <- o .: "delete" >>= (.: "status") Delete <$> s .: "id" <*> s .: "user_id" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse delete from: " ++ show v instance ToJSON Delete where toJSON Delete{..} = object [ "delete" .= object [ "status" .= object [ "id" .= delId @@ -484,7 +489,7 @@ , userURL :: Maybe URIString , userUtcOffset :: Maybe Int , userVerified :: Bool - , userWithheldInCountries :: Maybe Text + , userWithheldInCountries :: Maybe [Text] , userWithheldScope :: Maybe Text } deriving (Show, Eq, Data, Typeable, Generic) @@ -530,7 +535,7 @@ <*> o .: "verified" <*> o .:? "withheld_in_countries" <*> o .:? "withheld_scope" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse user from: " ++ show v instance ToJSON User where toJSON User{..} = object [ "contributors_enabled" .= userContributorsEnabled @@ -595,7 +600,7 @@ <*> o .: "subscriber_count" <*> o .: "mode" <*> o .: "user" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse List from: " ++ show v instance ToJSON List where toJSON List{..} = object [ "id" .= listId @@ -617,7 +622,7 @@ instance FromJSON HashTagEntity where parseJSON (Object o) = HashTagEntity <$> o .: "text" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse hashtag entity from: " ++ show v instance ToJSON HashTagEntity where toJSON HashTagEntity{..} = object [ "text" .= hashTagText ] @@ -636,7 +641,7 @@ UserEntity <$> o .: "id" <*> o .: "name" <*> o .: "screen_name" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse user entity from: " ++ show v instance ToJSON UserEntity where toJSON UserEntity{..} = object [ "id" .= userEntityUserId @@ -658,7 +663,7 @@ URLEntity <$> o .: "url" <*> o .: "expanded_url" <*> o .: "display_url" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse url entity from: " ++ show v instance ToJSON URLEntity where toJSON URLEntity{..} = object [ "url" .= ueURL @@ -684,7 +689,7 @@ <*> o .: "media_url" <*> o .: "media_url_https" <*> parseJSON v - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse media entity from: " ++ show v instance ToJSON MediaEntity where toJSON MediaEntity{..} = object [ "type" .= meType @@ -711,7 +716,7 @@ MediaSize <$> o .: "w" <*> o .: "h" <*> o .: "resize" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse media size from: " ++ show v instance ToJSON MediaSize where toJSON MediaSize{..} = object [ "w" .= msWidth @@ -729,7 +734,7 @@ parseJSON (Object o) = Coordinates <$> o .: "coordinates" <*> o .: "type" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse coordinates from: " ++ show v instance ToJSON Coordinates where toJSON Coordinates{..} = object [ "coordinates" .= coordinates @@ -741,7 +746,7 @@ data Place = Place { placeAttributes :: HashMap Text Text - , placeBoundingBox :: BoundingBox + , placeBoundingBox :: Maybe BoundingBox , placeCountry :: Text , placeCountryCode :: Text , placeFullName :: Text @@ -754,7 +759,7 @@ instance FromJSON Place where parseJSON (Object o) = Place <$> o .: "attributes" - <*> o .: "bounding_box" + <*> o .:? "bounding_box" <*> o .: "country" <*> o .: "country_code" <*> o .: "full_name" @@ -762,7 +767,7 @@ <*> o .: "name" <*> o .: "place_type" <*> o .: "url" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse place from: " ++ show v instance ToJSON Place where toJSON Place{..} = object [ "attributes" .= placeAttributes @@ -788,7 +793,7 @@ parseJSON (Object o) = BoundingBox <$> o .: "coordinates" <*> o .: "type" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse bounding box from: " ++ show v instance ToJSON BoundingBox where toJSON BoundingBox{..} = object [ "coordinates" .= boundingBoxCoordinates @@ -811,7 +816,7 @@ <*> o .:? "user_mentions" .!= [] <*> o .:? "urls" .!= [] <*> o .:? "media" .!= [] - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse entities from: " ++ show v instance ToJSON Entities where toJSON Entities{..} = object [ "hashtags" .= enHashTags @@ -836,7 +841,7 @@ parseJSON v@(Object o) = Entity <$> parseJSON v <*> o .: "indices" - parseJSON _ = mzero + parseJSON v = fail $ "couldn't parse entity wrapper from: " ++ show v instance ToJSON a => ToJSON (Entity a) where toJSON Entity{..} = case toJSON entityBody of @@ -845,14 +850,16 @@ data Contributor = Contributor { contributorId :: UserId - , contributorScreenName :: Text + , contributorScreenName :: Maybe Text } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Contributor where parseJSON (Object o) = Contributor <$> o .: "id" - <*> o .: "screen_name" - parseJSON _ = mzero + <*> 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 diff --git a/tests/Instances.hs b/tests/Instances.hs --- a/tests/Instances.hs +++ b/tests/Instances.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Instances where @@ -8,12 +9,17 @@ import Control.Applicative import Data.DeriveTH import qualified Data.Text as T -import Data.Time 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 @@ -38,6 +44,8 @@ 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 @@ -55,9 +63,11 @@ <*> arbitrary <*> arbitrary <*> pure Nothing - <*> arbitrary + <*> pure (statusId <$> qt) + <*> pure qt <*> arbitrary <*> arbitrary + <*> pure rt <*> arbitrary <*> arbitrary <*> arbitrary diff --git a/tests/TypesTest.hs b/tests/TypesTest.hs --- a/tests/TypesTest.hs +++ b/tests/TypesTest.hs @@ -44,6 +44,8 @@ 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 @@ -52,6 +54,42 @@ 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 diff --git a/twitter-types.cabal b/twitter-types.cabal --- a/twitter-types.cabal +++ b/twitter-types.cabal @@ -1,5 +1,5 @@ name: twitter-types -version: 0.7.0 +version: 0.7.1 license: BSD3 license-file: LICENSE author: Takahiro HIMURA