twitter-types 0.6.0 → 0.6.1
raw patch · 4 files changed
+477/−33 lines, 4 filesdep +QuickCheckdep +derivedep +ghc-prim
Dependencies added: QuickCheck, derive, ghc-prim, test-framework-quickcheck2, twitter-types
Files
- Web/Twitter/Types.hs +284/−31
- tests/Instances.hs +105/−0
- tests/TypesTest.hs +78/−0
- twitter-types.cabal +10/−2
Web/Twitter/Types.hs view
@@ -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 <https://dev.twitter.com/docs/platform-objects/tweets>. 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 <https://dev.twitter.com/docs/platform-objects/users>. 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 <https://dev.twitter.com/docs/platform-objects/entities#obj-hashtags>. 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 <https://dev.twitter.com/docs/platform-objects/entities#obj-usermention>. 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 <https://dev.twitter.com/docs/platform-objects/entities#obj-url>. 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 <https://dev.twitter.com/docs/platform-objects/entities#obj-size>. 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 <https://dev.twitter.com/docs/platform-objects/places>. 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 <https://dev.twitter.com/docs/platform-objects/places#obj-boundingbox>. 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 <https://dev.twitter.com/docs/platform-objects/entities>. 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 <https://dev.twitter.com/docs/api/multiple-media-extended-entities>. 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+ ]
+ tests/Instances.hs view
@@ -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
tests/TypesTest.hs view
@@ -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
twitter-types.cabal view
@@ -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