hs-twitter 0.2.0 → 0.2.1

raw patch · 5 files changed

+27/−24 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Web/Twitter.hs +12/−10
• Web/Twitter/Fetch.hs +8/−7
• Web/Twitter/Monad.hs +2/−4
• Web/Twitter/Types.hs +1/−0
• hs-twitter.cabal +4/−3

@@ -285,9 +285,9 @@ -- Requires both the @user@ and @text@ parameters.
 -- Returns the sent message in the requested format when successful.  
 sendDirectMessage :: UserId -> String -> TM DirectMessage
-sendDirectMessage userId txt = withBase top_base_url $ withAuth True $ postMethod $ 
+sendDirectMessage uId txt = withBase top_base_url $ withAuth True $ postMethod $ 
    restCall dir
-            (arg "user" userId $ arg "text" txt []) >>= readResult "sendDirectMessage"
+            (arg "user" uId $ arg "text" txt []) >>= readResult "sendDirectMessage"
   where
    dir = "direct_messages/new.json"
 
@@ -368,6 +368,7 @@      , profileSidebarBorder :: Maybe ColorString
      }
 
+nullProfileColors :: ProfileColors
 nullProfileColors
  = ProfileColors
      { profileTextColor   = Nothing
@@ -400,7 +401,7 @@ 	     newPostRequest "img_upload"
      (url_q, hs, bod) <- liftIO (toRequest pr (Just PostFormData))
      let u = appendQueryArgs acc url_q
-     (_,_,xs) <- postCall u hs bod []
+     (_,_,_) <- postCall u hs bod []
      return ()
   where
    acc = "update_profile_image.json"
@@ -415,7 +416,7 @@ 	     newPostRequest "img_upload"
      (url_q, hs, bod) <- liftIO (toRequest pr (Just PostFormData))
      let u = appendQueryArgs acc url_q
-     (_,_,xs) <- postCall u hs bod []
+     (_,_,_) <- postCall u hs bod []
      return ()
   where
    acc = "update_profile_background_image.json"
@@ -432,6 +433,7 @@   where
    acc = "rate_limit_status.json"
 
+appendQueryArgs :: String -> String -> String
 appendQueryArgs x "" = x
 appendQueryArgs x y  = x ++ '?':y
 
@@ -458,13 +460,13 @@ -- specified will be updated; to only update the "name" attribute, for
 -- example, only include that as a @Just@ value in the @ProfileInfo@ parameter.
 updateProfile :: ProfileInfo -> TM ()
-updateProfile pi = withBase acc_base_url $ withAuth True $ postMethod $
+updateProfile pin = withBase acc_base_url $ withAuth True $ postMethod $
   restCall acc 
-           (mbArg "name" (profileInfoName pi) $
-	    mbArg "email"       (profileInfoEmail pi) $
-	    mbArg "url"       (profileInfoURL pi) $
-	    mbArg "location" (profileInfoLocation pi) $
-	    mbArg "description" (profileInfoDescription pi) $
+           (mbArg "name" (profileInfoName pin) $
+	    mbArg "email"       (profileInfoEmail pin) $
+	    mbArg "url"       (profileInfoURL pin) $
+	    mbArg "location" (profileInfoLocation pin) $
+	    mbArg "description" (profileInfoDescription pin) $
 	    []) >> return ()
  where
   acc = "update_profile.json"

@@ -65,7 +65,7 @@ readUserContentsURL :: Maybe AuthUser -> Bool -> Bool -> URLString -> [(String,String)] -> IO ([(String,String)], String)
 readUserContentsURL mbU doRedir isHead us hdrs = do -- readContentsURL u
   let hs = 
-       case parseHeaders $ map (\ (x,y) -> x++": " ++ y) (addDefaultHeaders hdrs) of
+       case parseHeaders $ map (\ (x,y) -> x++": " ++ y) (addDefaultHeaders 0 hdrs) of
          Left{} -> []
 	 Right xs -> xs
   req0 <- 
@@ -112,7 +112,7 @@ 		-> IO ([Cookie],[(String,String)], String)
 postContentsURL mbU u hdrs csIn body = do
   let hs = 
-       case parseHeaders $ map (\ (x,y) -> x++": " ++ y) (addDefaultHeaders hdrs) of
+       case parseHeaders $ map (\ (x,y) -> x++": " ++ y) (addDefaultHeaders  (length body) hdrs) of
          Left{} -> []
 	 Right xs -> xs
   req0 <- 
@@ -146,11 +146,12 @@ 
 toP (Header k v) = (show k, v)
 
-addDefaultHeaders :: [(String,String)] -> [(String,String)]
-addDefaultHeaders hs = 
-  case lookup "User-Agent" hs of
-    Nothing -> ("User-Agent", "hs-mw-utils"):hs
-    _ -> hs
+addDefaultHeaders :: Int -> [(String,String)] -> [(String,String)]
+addDefaultHeaders clen hs = 
+  addIfMiss "User-Agent" "hs-twitter" $
+  addIfMiss "Content-Length"  (show clen) hs
+ where
+  addIfMiss f v xs = maybe ((f,v):xs) (const xs) (lookup f xs)
 
 {- Curl versions:
 readUserContentsURL :: User -> URLString -> IO String

@@ -42,7 +42,6 @@        ) where
 
 import Text.JSON
-import Text.JSON.Types
 
 import Control.Monad
 import Data.List
@@ -90,8 +89,8 @@   case isA of
     Nothing -> liftIO (readContentsURL url)
     Just au 
-      | isP       -> liftIO (postContentsURL (Just au) url [] [] "" >>= \ (a,b,c) -> return c)
-      | otherwise -> liftIO (readUserContentsURL (Just au) True False{-is HEAD-} url [] >>= \ (a,b) -> return b)
+      | isP       -> liftIO (postContentsURL (Just au) url [] [] "" >>= \ (_,_,c) -> return c)
+      | otherwise -> liftIO (readUserContentsURL (Just au) True False{-is HEAD-} url [] >>= return.snd)
 
 postCall :: String -> [(String,String)] -> String -> [(String,String)] -> TM ([Cookie],[(String,String)], String)
 postCall u hs bod args = do
@@ -103,7 +102,6 @@   b   <- getBase
   let url = b++ u ++ case q of { [] -> u ; xs -> '?':u ++ intercalate "&" xs}
   isA <- getUser
-  isP <- getPostFlag
   liftIO (postContentsURL isA url hs [] bod)
 
 readResult :: JSON a => String -> String -> TM a 

@@ -1,6 +1,7 @@ module Web.Twitter.Types where
 
 type ColorString = String
+-- Thu Dec 25 21:07:16 +0000 2008 (sure there was a good reason not to use 8601..)
 type DateString  = String
 type UserId      = String
 type URLString   = String

@@ -1,10 +1,11 @@ name: hs-twitter
-version: 0.2.0
+version: 0.2.1
 synopsis: Haskell binding to the Twitter API
 description:
    The hs-twitter API binding lets you access twitter.com's
-   resources and methods from Haskell. Implements the
-   full API, as specified at <http://apiwiki.twitter.com/REST+API+Documentation>
+   resources and methods from Haskell.
+   . 
+   Implements the full API, see <http://apiwiki.twitter.com/REST+API+Documentation>
    .
    For more info on use, please visit <http://haskell.forkIO.com/twitter>