diff --git a/Web/Twitter/Types.hs b/Web/Twitter/Types.hs --- a/Web/Twitter/Types.hs +++ b/Web/Twitter/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, RecordWildCards, DeriveGeneric #-} module Web.Twitter.Types ( DateString @@ -38,12 +38,14 @@ ) where +import Control.Applicative +import Control.Monad import Data.Aeson import Data.Aeson.Types (Parser) +import Data.Data +import Data.HashMap.Strict (HashMap, fromList, union) import Data.Text (Text) -import Data.HashMap.Strict (HashMap) -import Control.Applicative -import Control.Monad +import GHC.Generics type DateString = String type UserId = Integer @@ -57,10 +59,10 @@ | SRetweetedStatus RetweetedStatus | SEvent Event | SDelete Delete - -- -- | SScrubGeo ScrubGeo + -- | SScrubGeo ScrubGeo | SFriends Friends | SUnknown Value - deriving (Show, Eq) + deriving (Show, Eq, Data, Typeable, Generic) checkError :: Object -> Parser () checkError o = do @@ -82,6 +84,14 @@ js = parseJSON v parseJSON _ = mzero +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 (SUnknown v) = v + -- | This type represents a Twitter tweet structure. -- See . data Status = Status @@ -112,7 +122,7 @@ , statusWithheldCopyright :: Maybe Bool , statusWithheldInCountries :: Maybe [Text] , statusWithheldScope :: Maybe Text - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Status where parseJSON (Object o) = checkError o >> @@ -145,11 +155,43 @@ <*> o .:? "withheld_scope" parseJSON _ = mzero +instance ToJSON Status where + toJSON Status{..} = object [ "contributors" .= statusContributors + , "coordinates" .= statusCoordinates + , "created_at" .= 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 + , "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) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON body => FromJSON (SearchResult body) where @@ -158,6 +200,12 @@ <*> o .: "search_metadata" parseJSON _ = mzero +instance ToJSON body => + ToJSON (SearchResult body) where + toJSON SearchResult{..} = object [ "statuses" .= searchResultStatuses + , "search_metadata" .= searchResultSearchMetadata + ] + data SearchStatus = SearchStatus { searchStatusCreatedAt :: DateString @@ -166,7 +214,7 @@ , searchStatusSource :: Text , searchStatusUser :: User , searchStatusCoordinates :: Maybe Coordinates - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON SearchStatus where parseJSON (Object o) = checkError o >> @@ -178,6 +226,15 @@ <*> o .:? "coordinates" parseJSON _ = mzero +instance ToJSON SearchStatus where + toJSON SearchStatus{..} = object [ "created_at" .= searchStatusCreatedAt + , "id" .= searchStatusId + , "text" .= searchStatusText + , "source" .= searchStatusSource + , "user" .= searchStatusUser + , "coordinates" .= searchStatusCoordinates + ] + data SearchMetadata = SearchMetadata { searchMetadataMaxId :: StatusId @@ -189,7 +246,7 @@ , searchMetadataSinceIdStr :: String , searchMetadataQuery :: String , searchMetadataMaxIdStr :: String - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON SearchMetadata where parseJSON (Object o) = checkError o >> @@ -204,6 +261,18 @@ <*> o .: "max_id_str" parseJSON _ = mzero +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 :: DateString @@ -215,7 +284,7 @@ , rsUser :: User , rsRetweetedStatus :: Status , rsCoordinates :: Maybe Coordinates - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON RetweetedStatus where parseJSON (Object o) = checkError o >> @@ -230,6 +299,18 @@ <*> o .:? "coordinates" parseJSON _ = mzero +instance ToJSON RetweetedStatus where + toJSON RetweetedStatus{..} = object [ "created_at" .= rsCreatedAt + , "id" .= rsId + , "text" .= rsText + , "source" .= rsSource + , "truncated" .= rsTruncated + , "entities" .= rsEntities + , "user" .= rsUser + , "retweeted_status" .= rsRetweetedStatus + , "coordinates" .= rsCoordinates + ] + data DirectMessage = DirectMessage { dmCreatedAt :: DateString @@ -242,7 +323,7 @@ , dmRecipientId :: UserId , dmSenderId :: UserId , dmCoordinates :: Maybe Coordinates - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON DirectMessage where parseJSON (Object o) = checkError o >> @@ -258,13 +339,26 @@ <*> o .:? "coordinates" parseJSON _ = mzero +instance ToJSON DirectMessage where + toJSON DirectMessage{..} = object [ "created_at" .= 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) + deriving (Show, Eq, Data, Typeable, Generic) data EventTarget = ETUser User | ETStatus Status | ETList List | ETUnknown Value - deriving (Show, Eq) + deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON EventTarget where parseJSON v@(Object o) = checkError o >> @@ -274,6 +368,12 @@ return (ETUnknown v) parseJSON _ = mzero +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 :: DateString @@ -281,7 +381,7 @@ , evEvent :: Text , evTarget :: EventTarget , evSource :: EventTarget - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Event where parseJSON (Object o) = checkError o >> @@ -292,11 +392,19 @@ <*> o .: "source" parseJSON _ = mzero +instance ToJSON Event where + toJSON Event{..} = object [ "created_at" .= evCreatedAt + , "target_object" .= evTargetObject + , "event" .= evEvent + , "target" .= evTarget + , "source" .= evSource + ] + data Delete = Delete { delId :: StatusId , delUserId :: UserId - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Delete where parseJSON (Object o) = checkError o >> do @@ -305,6 +413,13 @@ <*> s .: "user_id" parseJSON _ = mzero +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 @@ -348,7 +463,7 @@ , userVerified :: Bool , userWithheldInCountries :: Maybe Text , userWithheldScope :: Maybe Text - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON User where parseJSON (Object o) = checkError o >> @@ -394,6 +509,49 @@ <*> o .:? "withheld_scope" parseJSON _ = mzero +instance ToJSON User where + toJSON User{..} = object [ "contributors_enabled" .= userContributorsEnabled + , "created_at" .= 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 @@ -403,7 +561,7 @@ , listSubscriberCount :: Int , listMode :: Text , listUser :: User - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON List where parseJSON (Object o) = checkError o >> @@ -416,18 +574,31 @@ <*> o .: "user" parseJSON _ = mzero +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) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON HashTagEntity where parseJSON (Object o) = HashTagEntity <$> o .: "text" parseJSON _ = mzero +instance ToJSON HashTagEntity where + toJSON HashTagEntity{..} = object [ "text" .= hashTagText ] + -- | User mention entity. -- See . data UserEntity = @@ -435,7 +606,7 @@ { userEntityUserId :: UserId , userEntityUserName :: UserName , userEntityUserScreenName :: Text - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON UserEntity where parseJSON (Object o) = @@ -444,6 +615,12 @@ <*> o .: "screen_name" parseJSON _ = mzero +instance ToJSON UserEntity where + toJSON UserEntity{..} = object [ "id" .= userEntityUserId + , "name" .= userEntityUserName + , "screen_name" .= userEntityUserScreenName + ] + -- | URL entity. -- See . data URLEntity = @@ -451,7 +628,7 @@ { 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) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON URLEntity where parseJSON (Object o) = @@ -460,6 +637,12 @@ <*> o .: "display_url" parseJSON _ = mzero +instance ToJSON URLEntity where + toJSON URLEntity{..} = object [ "url" .= ueURL + , "expanded_url" .= ueExpanded + , "display_url" .= ueDisplay + ] + data MediaEntity = MediaEntity { meType :: Text @@ -468,7 +651,7 @@ , meMediaURL :: URIString , meMediaURLHttps :: URIString , meURL :: URLEntity - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON MediaEntity where parseJSON v@(Object o) = @@ -480,6 +663,17 @@ <*> parseJSON v parseJSON _ = mzero +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 = @@ -487,7 +681,7 @@ { msWidth :: Int , msHeight :: Int , msResize :: Text - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON MediaSize where parseJSON (Object o) = @@ -496,11 +690,17 @@ <*> o .: "resize" parseJSON _ = mzero +instance ToJSON MediaSize where + toJSON MediaSize{..} = object [ "w" .= msWidth + , "h" .= msHeight + , "resize" .= msResize + ] + data Coordinates = Coordinates { coordinates :: [Double] , coordinatesType :: Text - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Coordinates where parseJSON (Object o) = @@ -508,6 +708,11 @@ <*> o .: "type" parseJSON _ = mzero +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 = @@ -521,7 +726,7 @@ , placeName :: Text , placeType :: Text , placeURL :: Text - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Place where parseJSON (Object o) = @@ -536,13 +741,25 @@ <*> o .: "url" parseJSON _ = mzero +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) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON BoundingBox where parseJSON (Object o) = @@ -550,6 +767,11 @@ <*> o .: "type" parseJSON _ = mzero +instance ToJSON BoundingBox where + toJSON BoundingBox{..} = object [ "coordinates" .= boundingBoxCoordinates + , "type" .= boundingBoxType + ] + -- | Entity handling. -- See . data Entities = @@ -558,7 +780,7 @@ , enUserMentions :: [Entity UserEntity] , enURLs :: [Entity URLEntity] , enMedia :: [Entity MediaEntity] - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Entities where parseJSON (Object o) = @@ -568,6 +790,13 @@ <*> o .:? "media" .!= [] parseJSON _ = mzero +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. @@ -578,7 +807,7 @@ 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) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON a => FromJSON (Entity a) where parseJSON v@(Object o) = @@ -586,10 +815,15 @@ <*> o .: "indices" parseJSON _ = mzero +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 :: Text - } deriving (Show, Eq) + } deriving (Show, Eq, Data, Typeable, Generic) instance FromJSON Contributor where parseJSON (Object o) = @@ -597,12 +831,18 @@ <*> o .: "screen_name" parseJSON _ = mzero +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 + } deriving (Show, Eq, Data, Typeable, Generic) + instance FromJSON ImageSizeType where parseJSON (Object o) = ImageSizeType <$> o .: "w" @@ -610,16 +850,29 @@ <*> 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 + } 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 + ] diff --git a/tests/Instances.hs b/tests/Instances.hs new file mode 100644 --- /dev/null +++ b/tests/Instances.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Instances where + +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 + +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 + Status <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> pure Nothing + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> 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 diff --git a/tests/TypesTest.hs b/tests/TypesTest.hs --- a/tests/TypesTest.hs +++ b/tests/TypesTest.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module Main where @@ -7,13 +8,16 @@ import Test.Framework.TH.Prime 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 @@ -259,3 +263,77 @@ 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 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.6.0 +version: 0.6.1 license: BSD3 license-file: LICENSE author: Takahiro HIMURA @@ -25,12 +25,15 @@ , text , unordered-containers + 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, . + hs-source-dirs: tests main-is: TypesTest.hs build-depends: base >= 4.0 && < 5 @@ -38,7 +41,10 @@ , test-framework >= 0.3.3 , test-framework-th-prime , test-framework-hunit + , test-framework-quickcheck2 , HUnit + , QuickCheck + , derive , aeson , attoparsec , bytestring @@ -46,7 +52,9 @@ , unordered-containers , filepath , directory + , twitter-types other-modules: Fixtures + Instances ghc-options: -Wall