diff --git a/Web/Twitter/Types.hs b/Web/Twitter/Types.hs --- a/Web/Twitter/Types.hs +++ b/Web/Twitter/Types.hs @@ -46,9 +46,13 @@ import Data.Aeson.Types (Parser) import Data.Data import Data.HashMap.Strict (HashMap, fromList, union) +import Data.Int +import Data.Ratio import Data.Text (Text, unpack, pack) -import GHC.Generics +import Data.Text.Read (decimal) import Data.Time +import Data.Time.Clock.POSIX +import GHC.Generics newtype TwitterTime = TwitterTime { fromTwitterTime :: UTCTime } @@ -336,46 +340,54 @@ , "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 +type EventId = Integer + +data DirectMessage = DirectMessage + { dmId :: EventId + , dmCreatedTimestamp :: UTCTime + , dmTargetRecipientId :: UserId + , dmSenderId :: UserId + , dmText :: Text + , dmEntities :: Entities } deriving (Show, Eq, Data, Typeable, Generic) +parseIntegral :: Integral a => Text -> Parser a +parseIntegral v = either (fail $ "couldn't parse stringized int: " ++ show v) (return . fst) $ decimal v + +epochMsToUTCTime :: Int64 -> UTCTime +epochMsToUTCTime = posixSecondsToUTCTime . fromRational . (% 1000) . fromIntegral + +parseUnixTimeString :: Text -> Parser UTCTime +parseUnixTimeString = fmap epochMsToUTCTime <$> parseIntegral + +unixTimeToEpochInt :: UTCTime -> Int +unixTimeToEpochInt = floor . (* 1000) . utcTimeToPOSIXSeconds + 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 + parseJSON (Object o) = do + _ <- checkError o + messageCreate <- o .: "message_create" + messageData <- messageCreate .: "message_data" + DirectMessage + <$> (o .: "id" >>= parseIntegral) + <*> (o .: "created_timestamp" >>= parseUnixTimeString) + <*> (messageCreate .: "target" >>= (.: "recipient_id") >>= parseIntegral) + <*> (messageCreate .: "sender_id" >>= parseIntegral) + <*> messageData .: "text" + <*> messageData .: "entities" + parseJSON v = fail $ "couldn't parse direct message create event 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 - ] + toJSON DirectMessage {..} = + object + [ "id" .= show dmId + , "created_timestamp" .= show (unixTimeToEpochInt dmCreatedTimestamp) + , "message_create" .= object ["message_data" .= object ["text" .= dmText, "entities" .= dmEntities] + , "target" .= object ["recipient_id" .= show dmTargetRecipientId] + , "sender_id" .= show dmSenderId + ] + ] data EventType = Favorite | Unfavorite | ListCreated | ListUpdated | ListMemberAdded diff --git a/tests/Fixtures.hs b/tests/Fixtures.hs --- a/tests/Fixtures.hs +++ b/tests/Fixtures.hs @@ -1,39 +1,25 @@ -{-# 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 Data.ByteString as S import System.FilePath -import System.IO.Unsafe (unsafePerformIO) -import Control.Applicative - -parseJSONValue :: S.ByteString -> Value -parseJSONValue = fromJust . maybeResult . parse json +import Test.Tasty.HUnit -fixturePath :: String -fixturePath = takeDirectory __FILE__ "fixtures" +fixturePath :: FilePath -> FilePath +fixturePath filename = takeDirectory __FILE__ "fixtures" filename -loadFixture :: (S.ByteString -> a) -> String -> IO a -loadFixture conv filename = conv <$> S.readFile (fixturePath filename) +readFixtureFile :: FilePath -> IO ByteString +readFixtureFile = S.readFile . fixturePath -fixture :: (S.ByteString -> a) -> String -> a -fixture conv = unsafePerformIO . loadFixture conv +withFixtureJSON :: FromJSON a => FilePath -> (a -> Assertion) -> Assertion +withFixtureJSON filename assertions = do + body <- readFixtureFile filename + withJSON body assertions -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 ] +withJSON :: FromJSON a => ByteString -> (a -> Assertion) -> Assertion +withJSON body assertions = do + case eitherDecodeStrict' body of + Left err -> assertFailure $ err + Right result -> assertions result diff --git a/tests/Instances.hs b/tests/Instances.hs --- a/tests/Instances.hs +++ b/tests/Instances.hs @@ -1,17 +1,18 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Instances where import Control.Applicative import Data.Aeson -import Data.DeriveTH import Data.HashMap.Strict as HashMap import Data.String import qualified Data.Text as T import Data.Time (UTCTime (..), readTime, fromGregorian, defaultTimeLocale) -import Test.QuickCheck +import Generic.Random +import Test.Tasty.QuickCheck import Web.Twitter.Types instance IsString UTCTime where @@ -69,19 +70,37 @@ <*> 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 SearchStatus where + arbitrary = genericArbitraryU +instance Arbitrary SearchMetadata where + arbitrary = genericArbitraryU +instance Arbitrary RetweetedStatus where + arbitrary = genericArbitraryU +instance Arbitrary DirectMessage where + arbitrary = genericArbitrarySingleG customGens + where + customGens :: Gen Integer :+ () + customGens = + (getNonNegative <$> arbitrary) :+ () + +instance Arbitrary EventTarget where + arbitrary = genericArbitraryU +instance Arbitrary Event where + arbitrary = genericArbitraryU +instance Arbitrary Delete where + arbitrary = genericArbitraryU +instance Arbitrary User where + arbitrary = genericArbitraryU +instance Arbitrary List where + arbitrary = genericArbitraryU +instance Arbitrary HashTagEntity where + arbitrary = genericArbitraryU +instance Arbitrary UserEntity where + arbitrary = genericArbitraryU +instance Arbitrary URLEntity where + arbitrary = genericArbitraryU + instance Arbitrary MediaEntity where arbitrary = do ms <- arbitrary @@ -93,8 +112,10 @@ <*> arbitrary <*> arbitrary -derive makeArbitrary ''MediaSize -derive makeArbitrary ''Coordinates +instance Arbitrary MediaSize where + arbitrary = genericArbitraryU +instance Arbitrary Coordinates where + arbitrary = genericArbitraryU instance Arbitrary Place where arbitrary = do @@ -108,9 +129,12 @@ <*> arbitrary <*> arbitrary -derive makeArbitrary ''BoundingBox -derive makeArbitrary ''Entities -derive makeArbitrary ''ExtendedEntities +instance Arbitrary BoundingBox where + arbitrary = genericArbitraryU +instance Arbitrary Entities where + arbitrary = genericArbitraryU +instance Arbitrary ExtendedEntities where + arbitrary = genericArbitraryU instance Arbitrary ExtendedEntity where arbitrary = do ms <- arbitrary @@ -130,6 +154,9 @@ ind <- arbitrary return $ Entity a ind -derive makeArbitrary ''Contributor -derive makeArbitrary ''ImageSizeType -derive makeArbitrary ''UploadedMedia +instance Arbitrary Contributor where + arbitrary = genericArbitraryU +instance Arbitrary ImageSizeType where + arbitrary = genericArbitraryU +instance Arbitrary UploadedMedia where + arbitrary = genericArbitraryU diff --git a/tests/PropFromToJSONTest.hs b/tests/PropFromToJSONTest.hs new file mode 100644 --- /dev/null +++ b/tests/PropFromToJSONTest.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE TemplateHaskell #-} + +module PropFromToJSONTest where + +import Data.Aeson +import qualified Data.Aeson.Types as Aeson +import Instances() +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.TH +import Web.Twitter.Types + +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_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 + +tests :: TestTree +tests = $(testGroupGenerator) diff --git a/tests/TypesTest.hs b/tests/TypesTest.hs --- a/tests/TypesTest.hs +++ b/tests/TypesTest.hs @@ -1,88 +1,22 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} -module Main where - -import Web.Twitter.Types - -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.Framework.Providers.QuickCheck2 -import Test.HUnit +module TypesTest where -import Data.Aeson hiding (Error) -import Data.Aeson.Types (parseEither) +import Data.Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.HashMap.Strict as M import Data.Maybe - -import Instances() +import Data.Time.Clock.POSIX 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 +import Instances() +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.TH +import Web.Twitter.Types case_parseStatus :: Assertion -case_parseStatus = withJSON fixture_status01 $ \obj -> do +case_parseStatus = withFixtureJSON "status01.json" $ \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" @@ -105,7 +39,7 @@ statusCoordinates obj @?= Nothing case_parseStatusQuoted :: Assertion -case_parseStatusQuoted = withJSON fixture_status_quoted $ \obj -> do +case_parseStatusQuoted = withFixtureJSON "status_quoted.json" $ \obj -> do statusId obj @?= 641660763770372100 statusText obj @?= "Wow! Congrats! https://t.co/EPMMldEcci" statusQuotedStatusId obj @?= Just 641653574284537900 @@ -141,7 +75,7 @@ case_parseStatusWithPhoto :: Assertion -case_parseStatusWithPhoto = withJSON fixture_status_thimura_with_photo $ \obj -> do +case_parseStatusWithPhoto = withFixtureJSON "status_thimura_with_photo.json" $ \obj -> do statusId obj @?= 491143410770657280 statusText obj @?= "近所の海です http://t.co/FjSOU8dDoD" statusTruncated obj @?= False @@ -173,7 +107,7 @@ statusCoordinates obj @?= Nothing case_parseStatusIncludeEntities :: Assertion -case_parseStatusIncludeEntities = withJSON fixture_status_with_entity $ \obj -> do +case_parseStatusIncludeEntities = withFixtureJSON "status_with_entity.json" $ \obj -> do statusId obj @?= 112652479837110273 statusRetweetCount obj @?= 0 (userScreenName . statusUser) obj @?= "imeoin" @@ -182,7 +116,7 @@ (hashTagText . entityBody . head . enHashTags) ent @?= "tcdisrupt" case_parseSearchStatusMetadata :: Assertion -case_parseSearchStatusMetadata = withJSON fixture_search_haskell $ \obj -> do +case_parseSearchStatusMetadata = withFixtureJSON "search_haskell.json" $ \obj -> do let status = (searchResultStatuses obj) :: [Status] length status @?= 1 @@ -198,32 +132,63 @@ searchMetadataMaxIdStr metadata @?= "495597397733433345" case_parseSearchStatusBodyStatus :: Assertion -case_parseSearchStatusBodyStatus = withJSON fixture_search_haskell $ \obj -> do +case_parseSearchStatusBodyStatus = withFixtureJSON "search_haskell.json" $ \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 +case_parseSearchStatusBodySearchStatus = withFixtureJSON "search_haskell.json" $ \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 +data DMList = DMList + { dmList :: [DirectMessage] + } deriving (Show, Eq) +instance FromJSON DMList where + parseJSON = withObject "DMList" $ \obj -> DMList <$> obj .: "events" +case_parseDirectMessageList :: Assertion +case_parseDirectMessageList = + withFixtureJSON "direct_message_event_list.json" $ \obj -> do + dmList obj @?= + [ DirectMessage + { dmId = 123123123123123123 + , dmCreatedTimestamp = read "2019-10-13 18:15:48.951 UTC" + , dmTargetRecipientId = 186712193 + , dmSenderId = 69179963 + , dmText = "hello @thimura" + , dmEntities = + Entities + { enHashTags = [] + , enUserMentions = + [ Entity + { entityBody = + UserEntity + { userEntityUserId = 69179963 + , userEntityUserName = "ちむら" + , userEntityUserScreenName = "thimura" + } + , entityIndices = [6, 14] + } + ] + , enURLs = [] + , enMedia = [] + } + } + , DirectMessage + { dmId = 25252525252525 + , dmCreatedTimestamp = read "2019-10-13 18:06:46.14 UTC" + , dmTargetRecipientId = 186712193 + , dmSenderId = 69179963 + , dmText = "hello" + , dmEntities = Entities {enHashTags = [], enUserMentions = [], enURLs = [], enMedia = []} + } + ] + case_parseEventFavorite :: Assertion -case_parseEventFavorite = withJSON fixture_event_favorite_thimura $ \obj -> do +case_parseEventFavorite = withFixtureJSON "event_favorite_thimura.json" $ \obj -> do evCreatedAt obj @?= "Sat Aug 02 16:32:01 +0000 2014" evEvent obj @?= "favorite" let Just (ETStatus targetObj) = evTargetObject obj @@ -237,7 +202,7 @@ userScreenName sourceUser @?= "thimura_shinku" case_parseEventUnfavorite :: Assertion -case_parseEventUnfavorite = withJSON fixture_event_unfavorite_thimura $ \obj -> do +case_parseEventUnfavorite = withFixtureJSON "event_unfavorite_thimura.json" $ \obj -> do evCreatedAt obj @?= "Sat Aug 02 16:32:10 +0000 2014" evEvent obj @?= "unfavorite" let Just (ETStatus targetObj) = evTargetObject obj @@ -251,13 +216,13 @@ userScreenName sourceUser @?= "thimura_shinku" case_parseDelete :: Assertion -case_parseDelete = withJSON fixture_delete $ \obj -> do +case_parseDelete = withFixtureJSON "delete.json" $ \obj -> do delId obj @?= 495607981833064448 delUserId obj @?= 2566877347 case_parseErrorMsg :: Assertion -case_parseErrorMsg = - case parseStatus fixture_error_not_authorized of +case_parseErrorMsg = withFixtureJSON "error_not_authorized.json" $ \value -> + case parseStatus value of Aeson.Error str -> "Not authorized" @=? str Aeson.Success _ -> assertFailure "errorMsgJson should be parsed as an error." where @@ -265,9 +230,9 @@ parseStatus = Aeson.parse parseJSON case_parseMediaEntity :: Assertion -case_parseMediaEntity = withJSON fixture_media_entity $ \obj -> do +case_parseMediaEntity = withFixtureJSON "media_entity.json" $ \obj -> do let entities = statusEntities obj - assert $ isJust entities + assertBool "entities should not empty" $ isJust entities let Just ent = entities media = enMedia ent length media @?= 1 @@ -275,8 +240,8 @@ meType me @?= "photo" meId me @?= 114080493040967680 let sizes = meSizes me - assert $ M.member "thumb" sizes - assert $ M.member "large" sizes + assertBool "sizes must contains \"thumb\"" $ M.member "thumb" sizes + assertBool "sizes must contains \"large\"" $ M.member "large" sizes let Just mediaSize = M.lookup "large" sizes @@ -288,14 +253,14 @@ meMediaURLHttps me @?= "https://pbs.twimg.com/media/AZVLmp-CIAAbkyy.jpg" case_parseEmptyEntity :: Assertion -case_parseEmptyEntity = withJSON (parseJSONValue "{}") $ \entity -> do +case_parseEmptyEntity = withJSON "{}" $ \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 +case_parseEntityHashTag = withFixtureJSON "entity01.json" $ \entity -> do length (enHashTags entity) @?= 1 length (enUserMentions entity) @?= 1 length (enURLs entity) @?= 1 @@ -315,9 +280,9 @@ hashtag @?= "lol" case_parseExtendedEntities :: Assertion -case_parseExtendedEntities = withJSON fixture_media_extended_entity $ \obj -> do +case_parseExtendedEntities = withFixtureJSON "media_extended_entity.json" $ \obj -> do let entities = statusExtendedEntities obj - assert $ isJust entities + assertBool "entities should not empty" $ isJust entities let Just ent = entities media = exeMedia ent length media @?= 4 @@ -327,10 +292,8 @@ exeExtAltText me @?= Just "A small tabby kitten" exeType me @?= "photo" - - case_parseUser :: Assertion -case_parseUser = withJSON fixture_user_thimura $ \obj -> do +case_parseUser = withFixtureJSON "user_thimura.json" $ \obj -> do userId obj @?= 69179963 userName obj @?= "ちむら" userScreenName obj @?= "thimura" @@ -347,7 +310,7 @@ userFavoritesCount obj @?= 17313 case_parseUserLangNull :: Assertion -case_parseUserLangNull = withJSON fixture_user_thimura_lang_null $ \obj -> do +case_parseUserLangNull = withFixtureJSON "user_thimura_lang_null.json" $ \obj -> do userId obj @?= 69179963 userName obj @?= "ちむら" userScreenName obj @?= "thimura" @@ -365,7 +328,7 @@ userFavoritesCount obj @?= 17313 case_parseList :: Assertion -case_parseList = withJSON fixture_list_thimura_haskell $ \obj -> do +case_parseList = withFixtureJSON "list_thimura_haskell.json" $ \obj -> do listId obj @?= 20849097 listName obj @?= "haskell" listFullName obj @?= "@thimura/haskell" @@ -374,76 +337,5 @@ 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 +tests :: TestTree +tests = $(testGroupGenerator) diff --git a/tests/fixtures/direct_message_event_list.json b/tests/fixtures/direct_message_event_list.json new file mode 100644 --- /dev/null +++ b/tests/fixtures/direct_message_event_list.json @@ -0,0 +1,69 @@ +{ + "apps": { + "258901": { + "url": "http://twitter.com/download/android", + "name": "Twitter for Android", + "id": "258901" + }, + "3033300": { + "url": "https://mobile.twitter.com", + "name": "Twitter Web App", + "id": "3033300" + } + }, + "events": [ + { + "message_create": { + "source_app_id": "3033300", + "message_data": { + "entities": { + "symbols": [], + "urls": [], + "user_mentions": [ + { + "screen_name": "thimura", + "id_str": "69179963", + "name": "ちむら", + "indices": [ + 6, + 14 + ], + "id": 69179963 + } + ], + "hashtags": [] + }, + "text": "hello @thimura" + }, + "target": { + "recipient_id": "186712193" + }, + "sender_id": "69179963" + }, + "created_timestamp": "1570990548951", + "id": "123123123123123123", + "type": "message_create" + }, + { + "message_create": { + "source_app_id": "4237790", + "message_data": { + "entities": { + "symbols": [], + "urls": [], + "user_mentions": [], + "hashtags": [] + }, + "text": "hello" + }, + "target": { + "recipient_id": "186712193" + }, + "sender_id": "69179963" + }, + "created_timestamp": "1570990006140", + "id": "25252525252525", + "type": "message_create" + } + ] +} diff --git a/tests/fixtures/direct_message_thimura.json b/tests/fixtures/direct_message_thimura.json deleted file mode 100644 --- a/tests/fixtures/direct_message_thimura.json +++ /dev/null @@ -1,1 +0,0 @@ -{"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} diff --git a/tests/fixtures/user_thimura_lang_null.json b/tests/fixtures/user_thimura_lang_null.json --- a/tests/fixtures/user_thimura_lang_null.json +++ b/tests/fixtures/user_thimura_lang_null.json @@ -1,1 +1,1 @@ -{"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":null,"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} +{"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":null,"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":null,"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} diff --git a/tests/spec_main.hs b/tests/spec_main.hs new file mode 100644 --- /dev/null +++ b/tests/spec_main.hs @@ -0,0 +1,16 @@ +module Main where + +import Test.Tasty +import qualified TypesTest +import qualified PropFromToJSONTest + +tests :: TestTree +tests = + testGroup + "Tests" + [ testGroup "Unit Test" [TypesTest.tests] + , testGroup "Property Test" [PropFromToJSONTest.tests] + ] + +main :: IO () +main = defaultMain tests 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.8.0 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Takahiro HIMURA @@ -40,28 +40,28 @@ test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests - main-is: TypesTest.hs + main-is: spec_main.hs build-depends: base >= 4.9 && < 5 , twitter-types - , HUnit - , QuickCheck , aeson , attoparsec , bytestring - , derive + , generic-random , directory , filepath - , template-haskell - , test-framework >= 0.3.3 - , test-framework-hunit - , test-framework-quickcheck2 + , tasty >= 0.7 + , tasty-hunit + , tasty-quickcheck + , tasty-th , text , time , unordered-containers other-modules: Fixtures Instances + PropFromToJSONTest + TypesTest ghc-options: -Wall default-language: Haskell2010