hs-twitter 0.2.5 → 0.2.6

raw patch · 5 files changed

+109/−11 lines, 5 filesdep ~json

Dependency ranges changed: json

Files

• Web/Twitter.hs +50/−4
• Web/Twitter/Monad.hs +32/−6
• Web/Twitter/Types.hs +5/−0
• Web/Twitter/Types/Import.hs +21/−0
• hs-twitter.cabal +1/−1

@@ -17,6 +17,7 @@        ( getPublicTimeline   -- :: TM [Status]
        , getFriendsTimeline  -- :: Maybe DateString -> Maybe String -> TM [Status]
        , getUserTimeline     -- :: Maybe String -> Maybe DateString -> Maybe String -> TM [Status]
+       , getMentions         -- :: Maybe String -> Maybe String -> TM [Status]
 
        , showStatus          -- :: String -> TM Status
        , update              -- :: String -> Maybe String -> TM ()
@@ -35,6 +36,9 @@        , createFriend          -- :: UserId -> Maybe Bool -> TM User
        , destroyFriend         -- :: UserId -> TM ()
        , isFriendOf            -- :: UserId -> UserId -> TM Bool
+       
+       , getUserFollowers      -- :: Maybe String -> Maybe UserId -> Maybe String -> TM [UserId]
+       , getUserFollowing      -- :: Maybe String -> Maybe UserId -> Maybe String -> TM [UserId]
 
        , verifyCredentials     -- :: TM User
        , endSession            -- :: TM ()
@@ -75,6 +79,7 @@        , setUpdateInterval
        , setTwitterUser
        , tweet
+       , tweetTM
        , stopUpdates
        , addSearchFilter
        , dropSearch
@@ -233,6 +238,15 @@        runTM au (update s Nothing)
        return ()
 
+tweetTM :: TM a -> IO a
+tweetTM act = do
+   r <- readMVar twitter_user
+   case r of
+     Nothing -> do
+       fail "Unable to run tweeting action; no user set - run 'setTwitterUser'" -- "
+     Just au -> do
+       runTM au act
+
 nowDateString :: IO String
 nowDateString = do
   c <- getClockTime
@@ -253,8 +267,7 @@ -- the authenticating user and that user's friends. Optionally constrained by start date
 -- or a status ID.
 getFriendsTimeline :: Maybe DateString -> Maybe String -> TM [Status]
-getFriendsTimeline since sinceId = withAuth True $ 
-   restCall fri 
+getFriendsTimeline since sinceId = withAuth True $ restCall fri 
        (mbArg "since" since $
 	  mbArg "since_id" sinceId []) >>= readResult "getFriendsTimeline"
   where
@@ -264,7 +277,8 @@ -- posted from the authenticating user. It's also possible to request another user's 
 -- timeline via the id parameter below. 
 getUserTimeline :: Maybe String -> Maybe DateString -> Maybe String -> TM [Status]
-getUserTimeline mbId since sinceId = withAuth True $ 
+getUserTimeline mbId since sinceId = do
+  withAuth True $ 
    restCall usr
        (mbArg "id" mbId $
         mbArg "since" since $
@@ -272,6 +286,18 @@   where
    usr = "user_timeline.json"
    
+-- | @getMentions@ mbId mbMax@ returns the 20 most recent 
+-- mentions (status containing @username) for the 
+-- authenticating user.
+getMentions :: Maybe String -> Maybe String -> TM [Status]
+getMentions mbId mbMax = withAuth True $ 
+   restCall usr
+       (mbArg "max_id" mbMax $
+	mbArg "since_id" mbId []) >>= readResult "getMentions"
+  where
+   usr = "mentions.json"
+
+
 -- | @showStatus id@ returns a single status, specified by the @id@ parameter.
 -- The status's author will be returned inline.
 showStatus :: String -> TM Status
@@ -338,7 +364,7 @@     restCall folly 
               (mbArg "email" mbEmail []) >>= readResult "getUserInfo"
   where
-   folly = maybe "show.json" (\i -> "show/" ++ i ++ ".json") mbId
+   folly = maybe "users/show.json" (\i -> "users/show/" ++ i ++ ".json") mbId
   
 -- | @getDirectMesssages mbSince mbSinceId@ returns a list of the 20 most
 -- recent direct messages sent to the authenticating user.
@@ -410,6 +436,26 @@ toB :: Bool -> String
 toB False = "false"
 toB True  = "true"
+
+-- | @getUserFollowing mbId mbUser mbScreen@ returns a list of numeric IDs for every user
+-- the given user is following.
+getUserFollowing :: Maybe String -> Maybe String -> Maybe String -> TM [UserId]
+getUserFollowing mbId mbUserId mbScreen = withBase top_base_url $ withAuth True $ 
+  restCall fr (mbArg  "id" mbId $ 
+                mbArg "user_id" mbUserId $
+		 mbArg "screen_name" mbScreen []) >>= readResult "getUserFollowing" >>= return.(map userID)
+ where
+  fr = "friends/ids.json"
+
+-- | @getUserFollowers mbId mbUser mbScreen@ returns a list of numeric IDs for every user
+-- following the given user.
+getUserFollowers :: Maybe String -> Maybe String -> Maybe String -> TM [UserId]
+getUserFollowers mbId mbUserId mbScreen = withBase top_base_url $ withAuth True $ 
+  restCall fr (mbArg  "id" mbId $ 
+                mbArg "user_id" mbUserId $
+		 mbArg "screen_name" mbScreen []) >>= readResult "getUserFollowers" >>= return.(map userID)
+ where
+  fr = "followers/ids.json"
 
 -- | @verifyCredentials@ returns an HTTP 200 OK response code and a 
 -- representation of the requesting user if authentication was successful; 

@@ -1,3 +1,17 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Web.Twitter.Monad
+-- Description : Monad for all things Twitter.
+-- Copyright   : (c) Sigbjorn Finne, 2008-2009
+-- License     : BSD3
+--
+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
+-- Stability : provisional
+-- Portability: portable
+--
+-- Monad for bookkeeping Twitter interactions.
+-- 
+--------------------------------------------------------------------
 module Web.Twitter.Monad 
        ( TM
        , TMEnv(..)
@@ -9,6 +23,7 @@        , withPageCount
        , withAuth
        , withBase
+       , withDefaultArgs
        
        , getEnv
        , getUser
@@ -17,6 +32,7 @@        , getPageCount
        , getBase
        , getPostFlag
+       , getDefArgs
        
        , runTwitter
        , runTM
@@ -52,16 +68,16 @@ import Web.Twitter.Fetch
 
 api_base :: URLString
-api_base = "http://www.twitter.com/statuses/"
+api_base = "http://twitter.com/statuses/"
 
 top_base_url :: URLString
-top_base_url = "http://www.twitter.com/"
+top_base_url = "http://twitter.com/"
 
 user_base_url :: URLString
-user_base_url = "http://www.twitter.com/users/"
+user_base_url = "http://twitter.com/users/"
 
 acc_base_url :: URLString
-acc_base_url = "http://www.twitter.com/account/"
+acc_base_url = "http://twitter.com/account/"
 
 search_base_url :: URLString
 search_base_url = "http://search.twitter.com/"
@@ -89,9 +105,10 @@ restCall u args = do
   mbc <- getCount
   mbp <- getPage
+  d_args <- getDefArgs 
   let q = maybe id (\ x -> (("count="++show x):)) mbc $
             maybe id (\ x -> (("page="++show x):)) mbp $
-	     (map (\ (x,y) -> x ++ '=':encodeString y) args)
+	     (map (\ (x,y) -> x ++ '=':encodeString y) (args++d_args))
   b   <- getBase
   let url = b++ u ++ case q of { [] -> "" ; xs -> '?':intercalate "&" xs}
   isA <- getUser
@@ -106,9 +123,10 @@ postCall u hs bod args = do
   mbc <- getCount
   mbp <- getPage
+  d_args <- getDefArgs 
   let q = maybe id (\ x -> (("count="++show x):)) mbc $
             maybe id (\ x -> (("page="++show x):)) mbp $
-	     (map (\ (x,y) -> x ++ '=':encodeString y) args)
+	     (map (\ (x,y) -> x ++ '=':encodeString y) (args++d_args))
   b   <- getBase
   let url = b++ u ++ case q of { [] -> u ; xs -> '?':u ++ intercalate "&" xs}
   isA <- getUser
@@ -131,6 +149,7 @@      , tmCount :: Maybe Int
      , tmPage  :: Maybe Int
      , tmPost  :: Bool
+     , tmDefaultArgs :: [(String, String)]
      }
 
 nullEnv :: TMEnv
@@ -140,6 +159,7 @@   , tmCount = Nothing
   , tmPage  = Nothing
   , tmPost  = False
+  , tmDefaultArgs = [("source", "<a href=\"http://haskell.forkIO.com/twitter\">hs-twitter</a>")]
   }
 
 newtype TM a = TM {unTM :: TMEnv -> IO a}
@@ -165,6 +185,9 @@ withBase :: URLString -> TM a -> TM a
 withBase u t = withEnv (\ e -> e{tmBase=u}) t
 
+withDefaultArgs :: [(String,String)] -> TM a -> TM a
+withDefaultArgs as t = withEnv (\ e -> e{tmDefaultArgs=as}) t
+
 withPageCount :: Maybe Int -> Maybe Int -> TM a -> TM a
 withPageCount mbP mbC k = withEnv (\e -> e{tmPage=mbP,tmCount=mbC}) k
 
@@ -192,6 +215,9 @@ 
 getPageCount :: TM (Maybe Int, Maybe Int)
 getPageCount = TM $ \ env -> return (tmCount env, tmPage env)
+
+getDefArgs :: TM [(String,String)]
+getDefArgs = TM $ \ env -> return (tmDefaultArgs env)
 
 getBase :: TM URLString
 getBase = TM $ \ env -> return (tmBase env)

@@ -26,6 +26,8 @@ 
 data Format = FormatXML | FormatJSON | FormatRSS | FormatAtom
 
+newtype UserID = UserID { userID :: UserId }
+
 -- | @Status@ is the record type used to represent a ''tweet'',
 -- a status update by a user.
 data Status
@@ -215,3 +217,6 @@      , searchResultToUser     = Nothing
      , searchResultToUserId   = Nothing
      }
+
+nullUserID :: UserID
+nullUserID  = UserID { userID = "" }

@@ -195,6 +195,21 @@ 
     readJSONs _  = Error ("Unable to read search results")
 
+instance JSON UserID where
+    showJSON u = showJSON (userID u)
+    readJSON m = 
+       case m of
+	 JSRational v -> return (UserID (show ((round v) :: Integer)))
+	 _ -> return (UserID (showJSValue m ""))
+
+    readJSONs (JSObject (JSONObject (("ids", JSArray xs):_))) = do
+       mapM (\ x -> readJS "Web.Twitter.Types.UserID" "id" nullUserID readUserID x) xs
+    readJSONs (JSArray xs) = do
+       mapM (\ x -> readJSON x) xs
+
+    readJSONs x  = trace (show x) $ Error ("Unable to read user ID")
+    
+
 showUser :: User -> [(String, JSValue)]
 showUser u = 
   [ "id"           -=> str  $ userId u
@@ -494,3 +509,9 @@      , searchResultToUser   = tu
      , searchResultToUserId = tui
      }
+
+readUserID :: JM UserID
+readUserID = do
+  e <- getEnv
+  u <- trace (show e) $ get "id"
+  return UserID{userID=u}

@@ -1,5 +1,5 @@ name: hs-twitter
-version: 0.2.5
+version: 0.2.6
 synopsis: Haskell binding to the Twitter API
 description:
    The hs-twitter API binding lets you access twitter.com's