packages feed

twitter-enumerator (empty) → 0.0.1

raw patch · 8 files changed

+702/−0 lines, 8 filesdep +aesondep +attoparsecdep +attoparsec-enumeratorsetup-changed

Dependencies added: aeson, attoparsec, attoparsec-enumerator, authenticate, base, bytestring, containers, enumerator, http-enumerator, http-types, mtl, text, vector

Files

+ 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,2 @@+import Distribution.Simple+main = defaultMain
+ Web/Twitter/Enumerator.hs view
@@ -0,0 +1,10 @@+module Web.Twitter.Enumerator+       ( module Web.Twitter.Enumerator.Types+       , module Web.Twitter.Enumerator.Monad+       , module Web.Twitter.Enumerator.Fetch+       )+       where++import Web.Twitter.Enumerator.Types+import Web.Twitter.Enumerator.Monad+import Web.Twitter.Enumerator.Fetch
+ Web/Twitter/Enumerator/Fetch.hs view
@@ -0,0 +1,295 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.Twitter.Enumerator.Fetch+       ( api+       , QueryUser(..)+       , QueryList(..)++       -- * Timelines+       , statusesHomeTimeline+       , statusesMentions+       , statusesPublicTimeline+       , statusesRetweetedByMe+       , statusesRetweetedToMe+       , statusesRetweetsOfMe+       , statusesUserTimeline+       , statusesRetweetedToUser+       , statusesRetweetedByUser++       -- * Tweets+       , statusesIdRetweetedBy+       , statusesIdRetweetedByIds+       , statusesRetweetsId+       , statusesShowId++       -- * Search+       -- , search++       -- * Direct Messages+       -- , directMessages+       -- , directMessagesSent+       -- , directMessagesShowId++       -- * Friends & Followers+       , friendsIds+       , followersIds+       -- , friendshipsExists+       -- , friendshipsIncoming+       -- , friendshipsOutgoing+       -- , friendshipsShow+       -- , friendshipsLookup+       -- , friendshipsNoRetweetIds++       -- * Users+       -- , usersLookup+       -- , usersProfileImageScreenName+       -- , usersSearch+       , usersShow+       -- , usersContributees+       -- , usersContributors++       -- * Suggested Users+       -- , usersSuggestions+       -- , usersSuggestionsSlug+       -- , usersSuggestionsSlugMembers++       -- * Favorites+       -- , favorites++       -- * Lists+       , listsAll+       -- , listsStatuses+       -- , listsMemberships+       -- , listsSubscribers+       -- , listsSubscribersShow+       -- , listsMembersShow+       , listsMembers+       -- , lists+       -- , listsShow+       -- , listsSubscriptions++       -- * StreamingAPI+       , userstream+       , statusesFilter+       )+       where++import Web.Twitter.Enumerator.Types+import Web.Twitter.Enumerator.Monad+import Web.Twitter.Enumerator.Utils++import Data.Aeson hiding (Error)+import qualified Data.Aeson.Types as AE++import Network.HTTP.Enumerator+import qualified Network.HTTP.Types as HT+import Data.Enumerator hiding (map, filter, drop, span, iterate)+import qualified Data.Enumerator.List as EL++import qualified Data.Text as T+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B8+import Control.Monad.Trans+import Control.Applicative++import qualified Data.Map as M++data QueryUser = QUserId UserId | QScreenName String+               deriving (Show, Eq)+data QueryList = QListId Integer | QListName String+               deriving (Show, Eq)++endpoint :: String+endpoint = "https://api.twitter.com/1/"++api :: String -> HT.Query -> Iteratee ByteString IO a -> Iteratee ByteString TW a+api url query iter = do+  req <- lift $ apiRequest url query+  httpMgr req (handleError iter)+  where+    handleError iter' st@(HT.Status sc _) _ =+      if 200 <= sc && sc < 300+      then iter'+      else throwError $ HTTPStatusCodeException st++httpMgr :: Request IO+        -> (HT.Status+            -> HT.ResponseHeaders+            -> Iteratee ByteString IO a)+        -> Iteratee ByteString TW a+httpMgr req iterf = do+  mgr <- lift getManager+  liftTrans $ http req iterf mgr++apiRequest :: String -> HT.Query -> TW (Request IO)+apiRequest uri query = do+  p <- getProxy+  req <- liftIO $ parseUrl uri >>= \r -> return $ r { queryString = query, proxy = p }+  signOAuthTW req++apiGet :: FromJSON a => String -> HT.Query -> Iteratee a IO b -> TW b+apiGet uri query iter = run_ $ api uri query (handleParseError iter')+  where iter' = enumJSON =$ EL.map fromJSON' =$ skipNothing =$ iter++statuses :: (FromJSON a, Show a) => String -> HT.Query -> Enumerator a TW b+statuses uri query = apiWithPages furi query 1+  where furi = endpoint ++ "statuses/" ++ uri++apiWithPages :: (FromJSON a, Show a) => String -> HT.Query -> Integer -> Enumerator a TW b+apiWithPages uri query initPage =+  checkContinue1 go initPage+  where+    go loop page k = do+      let query' = insertQuery "page" (toMaybeByteString page) query+      res <- lift $ run_ $ api uri query' (handleParseError (enumJSON =$ iterPageC))+      case res of+        Just [] -> k EOF+        Just xs -> k (Chunks xs) >>== loop (page + 1)+        Nothing -> k EOF++iterPageC :: (Monad m, FromJSON a) => Iteratee Value m (Maybe [a])+iterPageC = do+  ret <- EL.head+  case ret of+    Just v -> return . fromJSON' $ v+    Nothing -> return Nothing++insertQuery :: ByteString -> Maybe ByteString -> HT.Query -> HT.Query+insertQuery key value = mk+  where mk = M.toList . M.insert key value . M.fromList++statusesHomeTimeline :: HT.Query -> Enumerator Status TW a+statusesHomeTimeline = statuses "home_timeline.json"++statusesMentions :: HT.Query -> Enumerator Status TW a+statusesMentions = statuses "mentions.json"++statusesPublicTimeline :: HT.Query -> Enumerator Status TW a+statusesPublicTimeline = statuses "public_timeline.json"++statusesRetweetedByMe :: HT.Query -> Enumerator Status TW a+statusesRetweetedByMe = statuses "retweeted_by_me.json"++statusesRetweetedToMe :: HT.Query -> Enumerator Status TW a+statusesRetweetedToMe = statuses "retweeted_to_me.json"++statusesRetweetsOfMe :: HT.Query -> Enumerator Status TW a+statusesRetweetsOfMe = statuses "retweeted_of_me.json"++statusesUserTimeline :: HT.Query -> Enumerator Status TW a+statusesUserTimeline = statuses "user_timeline.json"++statusesRetweetedToUser :: HT.Query -> Enumerator Status TW a+statusesRetweetedToUser = statuses "retweeted_to_user.json"++statusesRetweetedByUser :: HT.Query -> Enumerator Status TW a+statusesRetweetedByUser = statuses "retweeted_by_user.json"++statusesIdRetweetedBy :: StatusId -> HT.Query -> Enumerator User TW a+statusesIdRetweetedBy status_id = statuses (show status_id ++ "/retweeted_by.json")++statusesIdRetweetedByIds :: StatusId -> HT.Query -> Enumerator UserId TW a+statusesIdRetweetedByIds status_id = statuses (show status_id ++ "/retweeted_by/ids.json")++statusesRetweetsId :: StatusId -> HT.Query -> TW [RetweetedStatus]+statusesRetweetsId status_id query = apiGet uri query EL.head_+  where uri = endpoint ++ "statuses/retweets/" ++ show status_id ++ ".json"++statusesShowId :: StatusId -> HT.Query -> TW Status+statusesShowId status_id query = apiGet (endpoint ++ "statuses/show/" ++ show status_id ++ ".json") query EL.head_++mkQueryUser :: QueryUser -> HT.Query+mkQueryUser (QUserId uid) =  [("user_id", toMaybeByteString uid)]+mkQueryUser (QScreenName sn) = [("screen_name", Just . B8.pack $ sn)]++mkQueryList :: QueryList -> HT.Query+mkQueryList (QListId lid) =  [("list_id", toMaybeByteString lid)]+mkQueryList (QListName listname) =+  [("slug", Just . B8.pack $ lstName),+   ("owner_screen_name", Just . B8.pack $ screenName)]+  where+    (screenName, ln) = span (/= '/') listname+    lstName = drop 1 ln++friendsIds, followersIds :: QueryUser -> Enumerator UserId TW a+friendsIds q = apiCursor (endpoint ++ "friends/ids.json") (mkQueryUser q) "ids" (-1)+followersIds q = apiCursor (endpoint ++ "followers/ids.json") (mkQueryUser q) "ids" (-1)++usersShow :: QueryUser -> TW User+usersShow q = apiGet (endpoint ++ "users/show.json") (mkQueryUser q) EL.head_++listsAll :: QueryUser -> Enumerator List TW a+listsAll q = apiCursor (endpoint ++ "lists/all.json") (mkQueryUser q) "" (-1)++listsMembers :: QueryList -> Enumerator User TW a+listsMembers q = apiCursor (endpoint ++ "lists/members.json") (mkQueryList q) "users" (-1)++data Cursor a =+  Cursor+  { cursorCurrent :: [a]+  , cursorPrev :: Maybe Integer+  , cursorNext :: Maybe Integer+  } deriving (Show, Eq)++iterCursor' :: (Monad m, FromJSON a) => T.Text -> Iteratee Value m (Maybe (Cursor a))+iterCursor' key = do+  ret <- EL.head+  case ret of+    Just v -> return . AE.parseMaybe (parseCursor key) $ v+    Nothing -> return Nothing++iterCursor :: (Monad m, FromJSON a) => T.Text -> Iteratee ByteString m (Maybe (Cursor a))+iterCursor key = enumLine =$ handleParseError (enumJSON =$ iterCursor' key)++handleParseError :: Monad m => Iteratee ByteString m b -> Iteratee ByteString m b+handleParseError iter = iter `catchError` hndl+  where+    getChunk = continue return+    hndl e = getChunk >>= \x -> case x of+      Chunks xs -> throwError $ PerserException e xs+      _ -> throwError $ PerserException e []++parseCursor :: FromJSON a => T.Text -> Value -> AE.Parser (Cursor a)+parseCursor key (Object o) =+  checkError o+  <|>+  Cursor <$> o .: key <*> o .:? "previous_cursor" <*> o .:? "next_cursor"+parseCursor _ v@(Array _) = return $ Cursor (maybe [] id $ fromJSON' v) Nothing Nothing+parseCursor _ o = fail $ "Error at parseCursor: unknown object " ++ show o++apiCursor+  :: (FromJSON a, Show a) =>+     String+     -> HT.Query+     -> T.Text+     -> Integer+     -> Enumerator a TW b+apiCursor uri query cursorKey initCur =+  checkContinue1 go initCur+  where+    go loop cursor k = do+      let query' = insertQuery "cursor" (toMaybeByteString cursor) query+      res <- lift $ run_ $ api uri query' (iterCursor cursorKey)+      case res of+        Just r -> do+          let nextCur = cursorNext r+              chunks = Chunks . cursorCurrent $ r+          case nextCur of+            -- TODO: clean up+            Just 0  -> k chunks+            Just nc -> k chunks >>== loop nc+            Nothing -> k chunks+        Nothing -> k EOF++{-# SPECIALIZE apiIter ::  Iteratee StreamingAPI IO b -> Iteratee ByteString IO b #-}+apiIter :: (FromJSON a, Monad m) => Iteratee a m b -> Iteratee ByteString m b+apiIter iter = enumLine =$ handleParseError (enumJSON =$ EL.map fromJSON' =$ skipNothing =$ iter)++userstream :: Iteratee StreamingAPI IO a -> Iteratee ByteString TW a+userstream = api "https://userstream.twitter.com/2/user.json" [] . apiIter++statusesFilter :: HT.Query -> Iteratee StreamingAPI IO a -> Iteratee ByteString TW a+statusesFilter query = api "https://stream.twitter.com/1/statuses/filter.json" query . apiIter++toMaybeByteString :: Show a => a -> Maybe ByteString+toMaybeByteString = Just . B8.pack . show
+ Web/Twitter/Enumerator/Monad.hs view
@@ -0,0 +1,69 @@+module Web.Twitter.Enumerator.Monad+       ( TW+       , TWEnv (..)+       , runTW+       , runTWManager+       , newEnv+       , getOAuth+       , getCredential+       , getProxy+       , getManager+       , signOAuthTW+       )+       where++import Web.Authenticate.OAuth+import Network.HTTP.Enumerator+import Control.Monad.Reader++type TW = ReaderT TWEnv IO++data TWEnv = TWEnv+             { twOAuth :: OAuth+             , twCredential :: Credential+             , twProxy :: Maybe Proxy+             , twManager :: Maybe Manager+             }++runTW' :: TWEnv -> TW a -> IO a+runTW' = flip runReaderT++runTW :: TWEnv -> TW a -> IO a+runTW env st =+  case twManager env of+    Nothing -> withManager $ \mgr -> runTWManager env mgr st+    Just _ -> runTW' env st++runTWManager :: TWEnv -> Manager -> TW a -> IO a+runTWManager env mgr st = runTW' env { twManager = Just mgr } st++newEnv :: OAuth -> TWEnv+newEnv tokens+  = TWEnv+    { twOAuth = tokens+    , twCredential = Credential []+    , twProxy = Nothing+    , twManager = Nothing+    }++getOAuth :: TW OAuth+getOAuth = asks twOAuth++getCredential :: TW Credential+getCredential = asks twCredential++getProxy :: TW (Maybe Proxy)+getProxy = asks twProxy++getManager :: TW Manager+getManager = do+  mgr <- asks twManager+  case mgr of+    Just m -> return m+    Nothing -> error "manager is not initialized"++signOAuthTW :: Request IO -> TW (Request IO)+signOAuthTW req = do+  oa <- getOAuth+  cred <- getCredential+  liftIO $ signOAuth oa cred req
+ Web/Twitter/Enumerator/Types.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}++module Web.Twitter.Enumerator.Types+       ( TwitterException(..)+       , DateString+       , UserId+       , URLString+       , UserName+       , StatusId+       , StreamingAPI(..)+       , Status(..)+       , RetweetedStatus(..)+       , EventTarget(..)+       , Event(..)+       , Delete(..)+       , User(..)+       , List(..)+       , checkError+       )+       where++import qualified Network.HTTP.Types as HT+import Data.Aeson+import Data.Aeson.Types (Parser)+import Data.Text as T+import Data.ByteString (ByteString)+import Data.Typeable+import Control.Applicative+import Control.Monad+import Control.Exception++data TwitterException = HTTPStatusCodeException HT.Status+                      | PerserException SomeException [ByteString]+                      | TwitterErrorMessage T.Text Value+                      deriving (Show, Typeable)+instance Exception TwitterException++type DateString  = String+type UserId      = Integer+type URLString   = String+type UserName    = T.Text+type StatusId    = Integer++data StreamingAPI = SStatus Status+                  | SRetweetedStatus RetweetedStatus+                  | SEvent Event+                  | SDelete Delete+                  -- -- | SScrubGeo ScrubGeo+                  | SFriends Friends+                  | SUnknown Value+                  deriving (Show, Eq)++checkError :: Object -> Parser a+checkError o = do+  err <- o .:? "error"+  case err of+    Just msg -> throw $ TwitterErrorMessage msg (Object o)+    Nothing -> mzero++instance FromJSON StreamingAPI where+  parseJSON v@(Object _) =+    SRetweetedStatus <$> js <|>+    SStatus <$> js <|>+    SEvent <$> js <|>+    SDelete <$> js <|>+    SFriends <$> js <|>+    (return $ SUnknown v)+    where+      js :: FromJSON a => Parser a+      js = parseJSON v+  parseJSON _ = mzero++data Status =+  Status+  { statusCreatedAt     :: DateString+  , statusId            :: StatusId+  , statusText          :: T.Text+  , statusSource        :: String+  , statusTruncated     :: Bool+  , statusInReplyTo     :: Maybe StatusId+  , statusInReplyToUser :: Maybe UserId+  , statusFavorite      :: Maybe Bool+  , 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 .:? "in_reply_to_status_id"+           <*> o .:? "in_reply_to_user_id"+           <*> o .:? "favorite"+           <*> o .:  "user"+  parseJSON _ = mzero++data RetweetedStatus =+  RetweetedStatus+  { rsCreatedAt       :: DateString+  , rsId              :: StatusId+  , rsText            :: T.Text+  , rsSource          :: String+  , rsTruncated       :: Bool+  , 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 .: "user"+                    <*> o .: "retweeted_status"+  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           :: String+  , 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++type Friends = [UserId]++data User =+  User+  { userId              :: UserId+  , userName            :: UserName+  , userScreenName      :: String+  , userDescription     :: T.Text+  , userLocation        :: T.Text+  , userProfileImageURL :: Maybe URLString+  , userURL             :: Maybe URLString+  , userProtected       :: Maybe Bool+  , userFollowers       :: Maybe Int+  } 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"+  parseJSON _ = mzero++data List =+  List+  { listId :: Int+  , listName :: String+  , listFullName :: String+  , listMemberCount :: Int+  , listSubscriberCount :: Int+  , listMode :: String+  , 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
+ Web/Twitter/Enumerator/Utils.hs view
@@ -0,0 +1,35 @@+module Web.Twitter.Enumerator.Utils+       ( enumLine+       , enumJSON+       , skipNothing+       , debugEE+       , fromJSON'+       )+       where++import Data.Aeson hiding (Error)+import Data.Aeson.Types (parseMaybe)+import Data.Attoparsec.Enumerator (iterParser)+import Data.Enumerator as E+import qualified Data.Enumerator.List as EL+import qualified Data.Enumerator.Binary as EB+import Data.ByteString (ByteString)+import Data.Maybe+import Control.Monad.Trans++enumLine :: Monad m => E.Enumeratee ByteString ByteString m a+enumLine = EB.splitWhen newline+  where newline x = (x == 10) || (x == 13)++skipNothing :: Monad m => E.Enumeratee (Maybe a) a m r+skipNothing = EL.concatMap (\x -> [fromJust x | isJust x])++debugEE :: (MonadIO m, Show a) => E.Enumeratee a a m r+debugEE = EL.mapM $ \x -> (liftIO . putStrLn . show) x >> return x++fromJSON' :: FromJSON a => Value -> Maybe a+fromJSON' = parseMaybe parseJSON++enumJSON :: Monad m => E.Enumeratee ByteString Value m a+enumJSON = E.sequence $ iterParser json+
+ twitter-enumerator.cabal view
@@ -0,0 +1,49 @@+name:              twitter-enumerator+version:           0.0.1+license:           BSD3+license-file:      LICENSE+author:            Takahiro HIMURA+maintainer:        taka@himura.jp+synopsis:          Twitter API package with enumerator interface and Streaming API support.+description:       This package uses enumerator package for access Twitter API.+category:          Web+stability:         Experimental+cabal-version:     >= 1.6+build-type:        Simple+homepage:          https://github.com/himura/twitter-enumerator++source-repository head+  type: git+  location: git://github.com/himura/twitter-enumerator.git++source-repository this+  type: git+  location: git://github.com/himura/twitter-enumerator.git+  tag: 0.0.1++library+  ghc-options: -Wall++  build-depends:+      base >= 4 && < 5+    , mtl+    , authenticate >= 0.9+    , enumerator >= 0.4.8 && < 0.5+    , http-types+    , http-enumerator >= 0.6.6+    , aeson >= 0.3.2.2+    , attoparsec >= 0.8.6.1+    , attoparsec-enumerator+    , bytestring+    , text+    , containers+    , vector >= 0.7++  exposed-modules:+    Web.Twitter.Enumerator+    Web.Twitter.Enumerator.Types+    Web.Twitter.Enumerator.Monad+    Web.Twitter.Enumerator.Fetch++  other-modules:+    Web.Twitter.Enumerator.Utils