diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c)2011, Takahiro Himura + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/Web/Twitter/Types.hs b/Web/Twitter/Types.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Types.hs @@ -0,0 +1,425 @@ +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} + +module Web.Twitter.Types + ( DateString + , UserId + , Friends + , URIString + , UserName + , StatusId + , LanguageCode + , StreamingAPI(..) + , Status(..) + , SearchResult(..) + , SearchStatus(..) + , SearchMetadata(..) + , RetweetedStatus(..) + , DirectMessage(..) + , EventTarget(..) + , Event(..) + , Delete(..) + , User(..) + , List(..) + , Entities(..) + , EntityIndices + , Entity(..) + , HashTagEntity(..) + , UserEntity(..) + , URLEntity(..) + , MediaEntity(..) + , MediaSize(..) + , checkError + ) + where + +import Data.Aeson +import Data.Aeson.Types (Parser) +import Data.Text (Text) +import Data.ByteString (ByteString) +import Data.HashMap.Strict (HashMap) +import Control.Applicative +import Control.Monad + +type DateString = String +type UserId = Integer +type Friends = [UserId] +type URIString = ByteString +type UserName = Text +type StatusId = Integer +type LanguageCode = String + +data StreamingAPI = SStatus Status + | SRetweetedStatus RetweetedStatus + | SEvent Event + | SDelete Delete + -- -- | SScrubGeo ScrubGeo + | SFriends Friends + | SUnknown Value + deriving (Show, Eq) + +checkError :: Object -> Parser () +checkError o = do + err <- o .:? "error" + case err of + Just msg -> fail msg + Nothing -> return () + +instance FromJSON StreamingAPI where + parseJSON v@(Object o) = + SRetweetedStatus <$> js <|> + SStatus <$> js <|> + SEvent <$> js <|> + SDelete <$> js <|> + SFriends <$> (o .: "friends") <|> + return (SUnknown v) + where + js :: FromJSON a => Parser a + js = parseJSON v + parseJSON _ = mzero + +data Status = + Status + { statusCreatedAt :: DateString + , statusId :: StatusId + , statusText :: Text + , statusSource :: Text + , statusTruncated :: Bool + , statusEntities :: Maybe Entities + , statusInReplyTo :: Maybe StatusId + , statusInReplyToUser :: Maybe UserId + , statusFavorite :: Maybe Bool + , statusRetweetCount :: Maybe Integer + , statusUser :: User + } deriving (Show, Eq) + +instance FromJSON Status where + parseJSON (Object o) = checkError o >> + Status <$> o .: "created_at" + <*> o .: "id" + <*> o .: "text" + <*> o .: "source" + <*> o .: "truncated" + <*> o .:? "entities" + <*> o .:? "in_reply_to_status_id" + <*> o .:? "in_reply_to_user_id" + <*> o .:? "favorited" + <*> o .:? "retweet_count" + <*> o .: "user" + parseJSON _ = mzero + +data SearchResult body = + SearchResult + { searchResultStatuses :: body + , searchResultSearchMetadata :: SearchMetadata + } deriving (Show, Eq) + +instance FromJSON body => + FromJSON (SearchResult body) where + parseJSON (Object o) = checkError o >> + SearchResult <$> o .: "statuses" + <*> o .: "search_metadata" + parseJSON _ = mzero + +data SearchStatus = + SearchStatus + { searchStatusCreatedAt :: DateString + , searchStatusId :: StatusId + , searchStatusText :: Text + , searchStatusSource :: Text + , searchStatusUser :: User + } deriving (Show, Eq) + +instance FromJSON SearchStatus where + parseJSON (Object o) = checkError o >> + SearchStatus <$> o .: "created_at" + <*> o .: "id" + <*> o .: "text" + <*> o .: "source" + <*> o .: "user" + parseJSON _ = mzero + +data SearchMetadata = + SearchMetadata + { searchMetadataMaxId :: StatusId + , searchMetadataSinceId :: StatusId + , searchMetadataRefreshUrl :: URIString + , searchMetadataNextResults :: Maybe URIString + , searchMetadataCount :: Int + , searchMetadataCompletedIn :: Maybe Float + , searchMetadataSinceIdStr :: String + , searchMetadataQuery :: String + , searchMetadataMaxIdStr :: String + } deriving (Show, Eq) + +instance FromJSON SearchMetadata where + parseJSON (Object o) = checkError o >> + SearchMetadata <$> o .: "max_id" + <*> o .: "since_id" + <*> o .: "refresh_url" + <*> o .:? "next_results" + <*> o .: "count" + <*> o .:? "completed_in" + <*> o .: "since_id_str" + <*> o .: "query" + <*> o .: "max_id_str" + parseJSON _ = mzero + +data RetweetedStatus = + RetweetedStatus + { rsCreatedAt :: DateString + , rsId :: StatusId + , rsText :: Text + , rsSource :: Text + , rsTruncated :: Bool + , rsEntities :: Maybe Entities + , rsUser :: User + , rsRetweetedStatus :: Status + } deriving (Show, Eq) + +instance FromJSON RetweetedStatus where + parseJSON (Object o) = checkError o >> + RetweetedStatus <$> o .: "created_at" + <*> o .: "id" + <*> o .: "text" + <*> o .: "source" + <*> o .: "truncated" + <*> o .:? "entities" + <*> o .: "user" + <*> o .: "retweeted_status" + parseJSON _ = mzero + +data DirectMessage = + DirectMessage + { dmCreatedAt :: DateString + , dmSenderScreenName :: Text + , dmSender :: User + , dmText :: Text + , dmRecipientScreeName :: Text + , dmId :: StatusId + , dmRecipient :: User + , dmRecipientId :: UserId + , dmSenderId :: UserId + } deriving (Show, Eq) + +instance FromJSON DirectMessage where + parseJSON (Object o) = checkError o >> + DirectMessage <$> o .: "created_at" + <*> o .: "sender_screen_name" + <*> o .: "sender" + <*> o .: "text" + <*> o .: "recipient_screen_name" + <*> o .: "id" + <*> o .: "recipient" + <*> o .: "recipient_id" + <*> o .: "sender_id" + parseJSON _ = mzero + +data EventType = Favorite | Unfavorite + | ListCreated | ListUpdated | ListMemberAdded + | UserUpdate | Block | Unblock | Follow + deriving (Show, Eq) + +data EventTarget = ETUser User | ETStatus Status | ETList List | ETUnknown Value + deriving (Show, Eq) + +instance FromJSON EventTarget where + parseJSON v@(Object o) = checkError o >> + ETUser <$> parseJSON v <|> + ETStatus <$> parseJSON v <|> + ETList <$> parseJSON v <|> + return (ETUnknown v) + parseJSON _ = mzero + +data Event = + Event + { evCreatedAt :: DateString + , evTargetObject :: Maybe EventTarget + , evEvent :: Text + , evTarget :: EventTarget + , evSource :: EventTarget + } deriving (Show, Eq) + +instance FromJSON Event where + parseJSON (Object o) = checkError o >> + Event <$> o .: "created_at" + <*> o .:? "target_object" + <*> o .: "event" + <*> o .: "target" + <*> o .: "source" + parseJSON _ = mzero + +data Delete = + Delete + { delId :: StatusId + , delUserId :: UserId + } deriving (Show, Eq) + +instance FromJSON Delete where + parseJSON (Object o) = checkError o >> do + s <- o .: "delete" >>= (.: "status") + Delete <$> s .: "id" + <*> s .: "user_id" + parseJSON _ = mzero + +data User = + User + { userId :: UserId + , userName :: UserName + , userScreenName :: Text + , userDescription :: Maybe Text + , userLocation :: Maybe Text + , userProfileImageURL :: Maybe URIString + , userURL :: Maybe URIString + , userProtected :: Maybe Bool + , userFollowers :: Maybe Int + , userFriends :: Maybe Int + , userTweets :: Maybe Int + , userLangCode :: Maybe LanguageCode + , userCreatedAt :: Maybe DateString + } deriving (Show, Eq) + +instance FromJSON User where + parseJSON (Object o) = checkError o >> + User <$> o .: "id" + <*> o .: "name" + <*> o .: "screen_name" + <*> o .:? "description" + <*> o .:? "location" + <*> o .:? "profile_image_url" + <*> o .:? "url" + <*> o .:? "protected" + <*> o .:? "followers_count" + <*> o .:? "friends_count" + <*> o .:? "statuses_count" + <*> o .:? "lang" + <*> o .:? "created_at" + parseJSON _ = mzero + +data List = + List + { listId :: Int + , listName :: Text + , listFullName :: Text + , listMemberCount :: Int + , listSubscriberCount :: Int + , listMode :: Text + , listUser :: User + } deriving (Show, Eq) + +instance FromJSON List where + parseJSON (Object o) = checkError o >> + List <$> o .: "id" + <*> o .: "name" + <*> o .: "full_name" + <*> o .: "member_count" + <*> o .: "subscriber_count" + <*> o .: "mode" + <*> o .: "user" + parseJSON _ = mzero + +data HashTagEntity = + HashTagEntity + { hashTagText :: Text -- ^ The Hashtag text + } deriving (Show, Eq) + +instance FromJSON HashTagEntity where + parseJSON (Object o) = + HashTagEntity <$> o .: "text" + parseJSON _ = mzero + +data UserEntity = + UserEntity + { userEntityUserId :: UserId + , userEntityUserName :: UserName + , userEntityUserScreenName :: Text + } deriving (Show, Eq) + +instance FromJSON UserEntity where + parseJSON (Object o) = + UserEntity <$> o .: "id" + <*> o .: "name" + <*> o .: "screen_name" + parseJSON _ = mzero + +data URLEntity = + URLEntity + { 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) + +instance FromJSON URLEntity where + parseJSON (Object o) = + URLEntity <$> o .: "url" + <*> o .: "expanded_url" + <*> o .: "display_url" + parseJSON _ = mzero + +data MediaEntity = + MediaEntity + { meType :: Text + , meId :: StatusId + , meSizes :: HashMap Text MediaSize + , meMediaURL :: URIString + , meMediaURLHttps :: URIString + , meURL :: URLEntity + } deriving (Show, Eq) + +instance FromJSON MediaEntity where + parseJSON v@(Object o) = + MediaEntity <$> o .: "type" + <*> o .: "id" + <*> o .: "sizes" + <*> o .: "media_url" + <*> o .: "media_url_https" + <*> parseJSON v + parseJSON _ = mzero + +data MediaSize = + MediaSize + { msWidth :: Int + , msHeight :: Int + , msResize :: Text + } deriving (Show, Eq) + +instance FromJSON MediaSize where + parseJSON (Object o) = + MediaSize <$> o .: "w" + <*> o .: "h" + <*> o .: "resize" + parseJSON _ = mzero + +-- | Entity handling. +data Entities = + Entities + { enHashTags :: [Entity HashTagEntity] + , enUserMentions :: [Entity UserEntity] + , enURLs :: [Entity URLEntity] + , enMedia :: [Entity MediaEntity] + } deriving (Show, Eq) + +instance FromJSON Entities where + parseJSON (Object o) = + Entities <$> o .:? "hashtags" .!= [] + <*> o .:? "user_mentions" .!= [] + <*> o .:? "urls" .!= [] + <*> o .:? "media" .!= [] + parseJSON _ = mzero + +-- | The character positions the Entity was extracted from +-- +-- This is experimental implementation. +-- This may be replaced by more definite types. +type EntityIndices = [Int] + +data Entity a = + 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) + +instance FromJSON a => FromJSON (Entity a) where + parseJSON v@(Object o) = + Entity <$> parseJSON v + <*> o .: "indices" + parseJSON _ = mzero diff --git a/Web/Twitter/Types/Lens.hs b/Web/Twitter/Types/Lens.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Types/Lens.hs @@ -0,0 +1,351 @@ +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, RankNTypes, CPP, FlexibleInstances #-} + +module Web.Twitter.Types.Lens + ( DateString + , UserId + , Friends + , URIString + , UserName + , StatusId + , LanguageCode + , StreamingAPI(..) + , Status + , SearchResult + , SearchStatus + , SearchMetadata + , RetweetedStatus + , DirectMessage + , EventTarget(..) + , Event + , Delete + , User + , List + , Entities + , EntityIndices + , Entity + , HashTagEntity + , UserEntity + , URLEntity + , MediaEntity + , MediaSize + + , statusCreatedAt + , statusId + , statusText + , statusSource + , statusTruncated + , statusEntities + , statusInReplyTo + , statusInReplyToUser + , statusFavorite + , statusRetweetCount + , statusUser + + , searchResultStatuses + , searchResultSearchMetadata + + , searchStatusCreatedAt + , searchStatusId + , searchStatusText + , searchStatusSource + , searchStatusUser + + , searchMetadataMaxId + , searchMetadataSinceId + , searchMetadataRefreshUrl + , searchMetadataNextResults + , searchMetadataCount + , searchMetadataCompletedIn + , searchMetadataSinceIdStr + , searchMetadataQuery + , searchMetadataMaxIdStr + + , rsCreatedAt + , rsId + , rsText + , rsSource + , rsTruncated + , rsEntities + , rsUser + , rsRetweetedStatus + + , dmCreatedAt + , dmSenderScreenName + , dmSender + , dmText + , dmRecipientScreeName + , dmId + , dmRecipient + , dmRecipientId + , dmSenderId + + , evCreatedAt + , evTargetObject + , evEvent + , evTarget + , evSource + + , delId + , delUserId + + , userId + , userName + , userScreenName + , userDescription + , userLocation + , userProfileImageURL + , userURL + , userProtected + , userFollowers + , userFriends + , userTweets + , userLangCode + , userCreatedAt + + , listId + , listName + , listFullName + , listMemberCount + , listSubscriberCount + , listMode + , listUser + + , hashTagText + + , userEntityUserId + , userEntityUserName + , userEntityUserScreenName + + , ueURL + , ueExpanded + , ueDisplay + + , meType + , meId + , meSizes + , meMediaURL + , meMediaURLHttps + , meURL + + , msWidth + , msHeight + , msResize + + , enHashTags + , enUserMentions + , enURLs + , enMedia + + , entityBody + , entityIndices + + , AsStatus(..) + , AsUser(..) + ) + where + +import Data.Functor +import qualified Web.Twitter.Types as TT +import Web.Twitter.Types + ( DateString + , UserId + , Friends + , URIString + , UserName + , StatusId + , LanguageCode + , StreamingAPI + , Status + , SearchResult + , SearchStatus + , SearchMetadata + , RetweetedStatus + , DirectMessage + , EventTarget + , Event + , Delete + , User + , List + , Entities + , EntityIndices + , Entity + , HashTagEntity + , UserEntity + , URLEntity + , MediaEntity + , MediaSize + ) +import Data.Text (Text) +import Data.HashMap.Strict (HashMap) + +type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t +type Lens' s a = Lens s s a a + +#define SIMPLE_LENS(name, s, a) \ +name :: Lens' (s) (a);\ +name f record = (\newVal -> record { TT.name = newVal }) <$> (f (TT.name record));\ +{-# INLINE name #-} + +#define TYPECHANGE_LENS(name, s) \ +name :: Lens ((s) a) ((s) b) (a) (b);\ +name f record = (\newVal -> record { TT.name = newVal }) <$> (f (TT.name record)) + +SIMPLE_LENS(statusCreatedAt , Status, DateString ) +SIMPLE_LENS(statusId , Status, StatusId ) +SIMPLE_LENS(statusText , Status, Text ) +SIMPLE_LENS(statusSource , Status, Text ) +SIMPLE_LENS(statusTruncated , Status, Bool ) +SIMPLE_LENS(statusEntities , Status, Maybe Entities ) +SIMPLE_LENS(statusInReplyTo , Status, Maybe StatusId ) +SIMPLE_LENS(statusInReplyToUser , Status, Maybe UserId ) +SIMPLE_LENS(statusFavorite , Status, Maybe Bool ) +SIMPLE_LENS(statusRetweetCount , Status, Maybe Integer ) +SIMPLE_LENS(statusUser , Status, User ) + +TYPECHANGE_LENS(searchResultStatuses , SearchResult ) +SIMPLE_LENS(searchResultSearchMetadata, SearchResult body, SearchMetadata ) + +SIMPLE_LENS(searchStatusCreatedAt , SearchStatus, DateString ) +SIMPLE_LENS(searchStatusId , SearchStatus, StatusId ) +SIMPLE_LENS(searchStatusText , SearchStatus, Text ) +SIMPLE_LENS(searchStatusSource , SearchStatus, Text ) +SIMPLE_LENS(searchStatusUser , SearchStatus, User ) + +SIMPLE_LENS(searchMetadataMaxId , SearchMetadata, StatusId ) +SIMPLE_LENS(searchMetadataSinceId , SearchMetadata, StatusId ) +SIMPLE_LENS(searchMetadataRefreshUrl , SearchMetadata, URIString ) +SIMPLE_LENS(searchMetadataNextResults , SearchMetadata, Maybe URIString ) +SIMPLE_LENS(searchMetadataCount , SearchMetadata, Int ) +SIMPLE_LENS(searchMetadataCompletedIn , SearchMetadata, Maybe Float ) +SIMPLE_LENS(searchMetadataSinceIdStr , SearchMetadata, String ) +SIMPLE_LENS(searchMetadataQuery , SearchMetadata, String ) +SIMPLE_LENS(searchMetadataMaxIdStr , SearchMetadata, String ) + +SIMPLE_LENS(rsCreatedAt , RetweetedStatus, DateString ) +SIMPLE_LENS(rsId , RetweetedStatus, StatusId ) +SIMPLE_LENS(rsText , RetweetedStatus, Text ) +SIMPLE_LENS(rsSource , RetweetedStatus, Text ) +SIMPLE_LENS(rsTruncated , RetweetedStatus, Bool ) +SIMPLE_LENS(rsEntities , RetweetedStatus, Maybe Entities ) +SIMPLE_LENS(rsUser , RetweetedStatus, User ) +SIMPLE_LENS(rsRetweetedStatus , RetweetedStatus, Status ) + +SIMPLE_LENS(dmCreatedAt , DirectMessage, DateString ) +SIMPLE_LENS(dmSenderScreenName , DirectMessage, Text ) +SIMPLE_LENS(dmSender , DirectMessage, User ) +SIMPLE_LENS(dmText , DirectMessage, Text ) +SIMPLE_LENS(dmRecipientScreeName , DirectMessage, Text ) +SIMPLE_LENS(dmId , DirectMessage, StatusId ) +SIMPLE_LENS(dmRecipient , DirectMessage, User ) +SIMPLE_LENS(dmRecipientId , DirectMessage, UserId ) +SIMPLE_LENS(dmSenderId , DirectMessage, UserId ) + +SIMPLE_LENS(evCreatedAt , Event, DateString ) +SIMPLE_LENS(evTargetObject , Event, Maybe EventTarget ) +SIMPLE_LENS(evEvent , Event, Text ) +SIMPLE_LENS(evTarget , Event, EventTarget ) +SIMPLE_LENS(evSource , Event, EventTarget ) + +SIMPLE_LENS(delId , Delete, StatusId ) +SIMPLE_LENS(delUserId , Delete, UserId ) + +SIMPLE_LENS(userId , User, UserId ) +SIMPLE_LENS(userName , User, UserName ) +SIMPLE_LENS(userScreenName , User, Text ) +SIMPLE_LENS(userDescription , User, Maybe Text ) +SIMPLE_LENS(userLocation , User, Maybe Text ) +SIMPLE_LENS(userProfileImageURL , User, Maybe URIString ) +SIMPLE_LENS(userURL , User, Maybe URIString ) +SIMPLE_LENS(userProtected , User, Maybe Bool ) +SIMPLE_LENS(userFollowers , User, Maybe Int ) +SIMPLE_LENS(userFriends , User, Maybe Int ) +SIMPLE_LENS(userTweets , User, Maybe Int ) +SIMPLE_LENS(userLangCode , User, Maybe LanguageCode ) +SIMPLE_LENS(userCreatedAt , User, Maybe DateString ) + +SIMPLE_LENS(listId , List, Int ) +SIMPLE_LENS(listName , List, Text ) +SIMPLE_LENS(listFullName , List, Text ) +SIMPLE_LENS(listMemberCount , List, Int ) +SIMPLE_LENS(listSubscriberCount , List, Int ) +SIMPLE_LENS(listMode , List, Text ) +SIMPLE_LENS(listUser , List, User ) + +SIMPLE_LENS(hashTagText , HashTagEntity, Text ) + +SIMPLE_LENS(userEntityUserId , UserEntity, UserId ) +SIMPLE_LENS(userEntityUserName , UserEntity, UserName ) +SIMPLE_LENS(userEntityUserScreenName , UserEntity, Text ) + +SIMPLE_LENS(ueURL , URLEntity, URIString ) +SIMPLE_LENS(ueExpanded , URLEntity, URIString ) +SIMPLE_LENS(ueDisplay , URLEntity, Text ) + +SIMPLE_LENS(meType , MediaEntity, Text ) +SIMPLE_LENS(meId , MediaEntity, StatusId ) +SIMPLE_LENS(meSizes , MediaEntity, HashMap Text MediaSize ) +SIMPLE_LENS(meMediaURL , MediaEntity, URIString ) +SIMPLE_LENS(meMediaURLHttps , MediaEntity, URIString ) +SIMPLE_LENS(meURL , MediaEntity, URLEntity ) + +SIMPLE_LENS(msWidth , MediaSize, Int ) +SIMPLE_LENS(msHeight , MediaSize, Int ) +SIMPLE_LENS(msResize , MediaSize, Text ) + +SIMPLE_LENS(enHashTags , Entities, [Entity HashTagEntity] ) +SIMPLE_LENS(enUserMentions , Entities, [Entity UserEntity] ) +SIMPLE_LENS(enURLs , Entities, [Entity URLEntity] ) +SIMPLE_LENS(enMedia , Entities, [Entity MediaEntity] ) + +TYPECHANGE_LENS(entityBody , Entity ) +SIMPLE_LENS(entityIndices , Entity a, EntityIndices ) + +class AsStatus s where + status_id :: Lens' s StatusId + text :: Lens' s Text + user :: Lens' s User + created_at :: Lens' s DateString + +instance AsStatus Status where + status_id = statusId + text = statusText + user = statusUser + created_at = statusCreatedAt + +instance AsStatus SearchStatus where + status_id = searchStatusId + text = searchStatusText + user = searchStatusUser + created_at = searchStatusCreatedAt + +instance AsStatus RetweetedStatus where + status_id = rsId + text = rsText + user = rsUser + created_at = rsCreatedAt + +instance AsStatus DirectMessage where + status_id = dmId + text = dmText + user = dmSender + created_at = dmCreatedAt + +class AsUser u where + user_id :: Lens' u UserId + name :: Lens' u UserName + screen_name :: Lens' u Text + +instance AsUser User where + user_id = userId + name = userName + screen_name = userScreenName + +instance AsUser UserEntity where + user_id = userEntityUserId + name = userEntityUserName + screen_name = userEntityUserScreenName + +instance AsUser (Entity UserEntity) where + user_id = entityBody.userEntityUserId + name = entityBody.userEntityUserName + screen_name = entityBody.userEntityUserScreenName diff --git a/tests/TypesTest.hs b/tests/TypesTest.hs new file mode 100644 --- /dev/null +++ b/tests/TypesTest.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Web.Twitter.Types + +import Test.Framework.TH.Prime +import Test.Framework.Providers.HUnit +import Test.HUnit +import Text.Shakespeare.Text + +import Data.Aeson hiding (Error) +import Data.Aeson.Types (parseEither) +import qualified Data.HashMap.Strict as M +import Data.Maybe + +import Fixtures + +main :: IO () +main = $(defaultMainGenerator) + +withJSON :: FromJSON a + => Value + -> (a -> Assertion) + -> Assertion +withJSON js f = either assertFailure id $ do + o <- parseEither parseJSON js + return $ f o + +case_parseStatus :: Assertion +case_parseStatus = withJSON statusJson $ \obj -> do + statusId obj @?= 112652479837110273 + statusRetweetCount obj @?= Just 0 + (userScreenName . statusUser) obj @?= "imeoin" + statusEntities obj @?= Nothing + +case_parseStatusIncludeEntities :: Assertion +case_parseStatusIncludeEntities = withJSON statusEntityJson $ \obj -> do + statusId obj @?= 112652479837110273 + statusRetweetCount obj @?= Just 0 + (userScreenName . statusUser) obj @?= "imeoin" + let ent = fromMaybe (Entities [] [] [] []) $ statusEntities obj + (map entityIndices . enHashTags) ent @?= [[32,42]] + (hashTagText . entityBody . head . enHashTags) ent @?= "tcdisrupt" + +case_parseErrorMsg :: Assertion +case_parseErrorMsg = + case parseStatus errorMsgJson of + Left str -> "Not authorized" @=? str + Right _ -> assertFailure "errorMsgJson should be parsed as an error." + where + parseStatus :: Value -> Either String Status + parseStatus = parseEither parseJSON + +case_parseMediaEntity :: Assertion +case_parseMediaEntity = withJSON mediaEntityJson $ \obj -> do + let entities = statusEntities obj + assert $ isJust entities + let Just ent = entities + media = enMedia ent + length media @?= 1 + let me = entityBody $ head media + ueURL (meURL me) @?= "http://t.co/rJC5Pxsu" + meMediaURLHttps me @?= "https://pbs.twimg.com/media/AZVLmp-CIAAbkyy.jpg" + let sizes = meSizes me + assert $ M.member "thumb" sizes + assert $ M.member "large" sizes + +case_parseEmptyEntity :: Assertion +case_parseEmptyEntity = withJSON (fj [st|{}|]) $ \entity -> do + length (enHashTags entity) @?= 0 + length (enUserMentions entity) @?= 0 + length (enURLs entity) @?= 0 + length (enMedia entity) @?= 0 + +case_parseEntityHashTag :: Assertion +case_parseEntityHashTag = withJSON (fj [st|{"symbols":[],"urls":[{"indices":[32,52], "url":"http://t.co/IOwBrTZR", "display_url":"youtube.com/watch?v=oHg5SJ\u2026", "expanded_url":"http://www.youtube.com/watch?v=oHg5SJYRHA0"}],"user_mentions":[{"name":"Twitter API", "indices":[4,15], "screen_name":"twitterapi", "id":6253282, "id_str":"6253282"}],"hashtags":[{"indices":[32,36],"text":"lol"}]}|]) $ \entity -> do + length (enHashTags entity) @?= 1 + length (enUserMentions entity) @?= 1 + length (enURLs entity) @?= 1 + length (enMedia entity) @?= 0 + + let urlEntity = entityBody . head . enURLs $ entity + ueURL urlEntity @?= "http://t.co/IOwBrTZR" + ueExpanded urlEntity @?= "http://www.youtube.com/watch?v=oHg5SJYRHA0" + ueDisplay urlEntity @?= "youtube.com/watch?v=oHg5SJ\x2026" + + let mentionsUser = entityBody . head . enUserMentions $ entity + userEntityUserName mentionsUser @?= "Twitter API" + userEntityUserScreenName mentionsUser @?= "twitterapi" + userEntityUserId mentionsUser @?= 6253282 + + let HashTagEntity hashtag = entityBody . head . enHashTags $ entity + hashtag @?= "lol" diff --git a/twitter-types.cabal b/twitter-types.cabal new file mode 100644 --- /dev/null +++ b/twitter-types.cabal @@ -0,0 +1,53 @@ +name: twitter-types +version: 0.1.20130101 +license: BSD3 +license-file: LICENSE +author: Takahiro HIMURA +maintainer: Takahiro HIMURA +synopsis: Twitter JSON parser and types +description: This package uses enumerator package for access Twitter API. +category: Web, Enumerator +stability: Experimental +cabal-version: >= 1.8 +build-type: Simple +homepage: https://github.com/himura/twitter-types + +source-repository head + type: git + location: git://github.com/himura/twitter-types.git + +library + ghc-options: -Wall + + build-depends: + base >= 4 && < 5 + , http-types + , aeson >= 0.3.2.2 + , bytestring + , text + , unordered-containers + + exposed-modules: + Web.Twitter.Types + Web.Twitter.Types.Lens + +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests, . + main-is: TypesTest.hs + build-depends: + base >= 4.0 && < 5 + , template-haskell + , test-framework >= 0.3.3 + , test-framework-th-prime + , test-framework-hunit + , HUnit + , shakespeare-text + , http-types + , aeson + , attoparsec + , bytestring + , text + , unordered-containers + + ghc-options: -Wall