twitter-types (empty) → 0.1.20130101
raw patch · 6 files changed
+953/−0 lines, 6 filesdep +HUnitdep +aesondep +attoparsecsetup-changed
Dependencies added: HUnit, aeson, attoparsec, base, bytestring, http-types, shakespeare-text, template-haskell, test-framework, test-framework-hunit, test-framework-th-prime, text, unordered-containers
Files
- LICENSE +26/−0
- Setup.hs +3/−0
- Web/Twitter/Types.hs +425/−0
- Web/Twitter/Types/Lens.hs +351/−0
- tests/TypesTest.hs +95/−0
- twitter-types.cabal +53/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ Web/Twitter/Types.hs view
@@ -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
+ Web/Twitter/Types/Lens.hs view
@@ -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
+ tests/TypesTest.hs view
@@ -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"
+ twitter-types.cabal view
@@ -0,0 +1,53 @@+name: twitter-types+version: 0.1.20130101+license: BSD3+license-file: LICENSE+author: Takahiro HIMURA+maintainer: Takahiro HIMURA <taka@himura.jp>+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