twitter-types 0.8.0 → 0.9.0
raw patch · 10 files changed
+369/−283 lines, 10 filesdep +generic-randomdep +tastydep +tasty-hunitdep −HUnitdep −QuickCheckdep −derive
Dependencies added: generic-random, tasty, tasty-hunit, tasty-quickcheck, tasty-th
Dependencies removed: HUnit, QuickCheck, derive, template-haskell, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- Web/Twitter/Types.hs +48/−36
- tests/Fixtures.hs +15/−29
- tests/Instances.hs +50/−23
- tests/PropFromToJSONTest.hs +85/−0
- tests/TypesTest.hs +76/−184
- tests/fixtures/direct_message_event_list.json +69/−0
- tests/fixtures/direct_message_thimura.json +0/−1
- tests/fixtures/user_thimura_lang_null.json +1/−1
- tests/spec_main.hs +16/−0
- twitter-types.cabal +9/−9
Web/Twitter/Types.hs view
@@ -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
tests/Fixtures.hs view
@@ -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
tests/Instances.hs view
@@ -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
+ tests/PropFromToJSONTest.hs view
@@ -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)
tests/TypesTest.hs view
@@ -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)
+ tests/fixtures/direct_message_event_list.json view
@@ -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"+ }+ ]+}
− tests/fixtures/direct_message_thimura.json
@@ -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}
tests/fixtures/user_thimura_lang_null.json view
@@ -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}
+ tests/spec_main.hs view
@@ -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
twitter-types.cabal view
@@ -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