hs-twitter 0.2.3 → 0.2.4

raw patch · 2 files changed

+37/−10 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Web/Twitter/Types/Import.hs +36/−9
• hs-twitter.cabal +1/−1

@@ -9,7 +9,7 @@ import Data.Maybe
 import Control.Monad
 
---import Debug.Trace
+import Debug.Trace
 
 data JM a = JM (String -> [(String,JSValue)] -> Result a)
 
@@ -26,6 +26,12 @@ runJM :: String -> [(String,JSValue)] -> JM a -> Result a
 runJM loc ps (JM a) = a loc ps
 
+catchJM :: JM a -> (String -> JM a) -> JM a
+catchJM (JM a) h = JM $ \ loc env -> 
+   case a loc env of
+     Error s -> case h s of { ( JM x) -> x loc env }
+     e@Ok{} -> e
+
 liftR :: Result a -> JM a
 liftR r = JM $ \ _ _ -> r
 
@@ -48,6 +54,17 @@        loc <- getLoc
        fail (loc ++ ": missing value for key " ++ show k)
 
+getDefault :: String -> String -> JM String
+getDefault def k = do
+  m <- getMb k 
+  case m of
+    Just (JSString s)  -> return (fromJSString s)
+    Just jso -> return (showJSValue jso "")
+    Nothing -> do
+       loc <- getLoc
+       trace (loc ++ " - warning: expected value for key " ++ shows k " but found none.")
+             (return def)
+
 getInt :: String -> JM Integer
 getInt k = do
   s <- get k
@@ -127,6 +144,7 @@        loc <- getLoc
        fail (loc ++ ": missing value for key " ++ show k)
 
+
 showJS :: (a -> [(String, JSValue)]) -> a -> JSValue
 showJS f x = JSObject (toJSObject (f x))
 
@@ -135,7 +153,13 @@ readJS m q n f (JSArray [x]) = readJS m q n f x
 readJS loc nm n f (JSObject (JSONObject [(x,ls@JSArray{})])) 
   | nm == x = readJS loc nm n f ls
-readJS m _ _ f (JSObject (JSONObject pairs)) = runJM m pairs f
+readJS m _ d f (JSObject (JSONObject pairs)) = runJM m pairs (catchJM f showErr)
+  where
+    showErr s = do
+      loc <- getLoc
+      trace (loc ++ ": " ++ s)
+            (return d)
+      
 readJS m _ _ _ v = fail (m ++ ": unexpected JSON value " ++ show v)
 
 instance JSON User where
@@ -219,7 +243,7 @@ 
 readUser :: JM User
 readUser = do
-  [i,nm,scr,des,loc] <- mapM get  ["id","name","screen_name","description","location"]
+  [i,nm,scr,des,loc] <- mapM (getDefault "")  ["id","name","screen_name","description","location"]
   prot <- getMbB "protected"
   mbU  <- getMbS "url"
   mbP  <- getMbS "profile_image_url"
@@ -260,7 +284,7 @@           return (addToEnv (("user", JSObject (JSONObject ls)):ps))
       _ -> return id
   augment $ do
-    [cr,i,te,src] <- mapM get  ["created_at","id","text","source"]
+    [cr,i,te,src] <- mapM get ["created_at","id","text","source"]
     u   <- getJ "user"
     tr  <- getB "truncated"
     inr <- getMbS "in_reply_to_status_id"
@@ -313,7 +337,8 @@    , desc,cre,tz
     , sn,loc
      , nm,i] 
-     <- mapM get  [ "profile_link_color"
+     <- mapM (getDefault "")
+                  [ "profile_link_color"
                   , "profile_background_color"
                   , "profile_text_color"
                   , "profile_sidebar_fill_color"
@@ -334,7 +359,7 @@   fav  <- getInt "favourites_count"
   sc   <- getInt "statuses_count"        
   fri  <- getInt "friends_count"
-  imgurl <- get "profile_image_url"
+  imgurl <- getDefault "" "profile_image_url"
   iurl   <- getMbS "url"
   return UserInfo
      { userInfoBackgroundTile = bgt
@@ -377,7 +402,9 @@ 
 readDM :: JM DirectMessage
 readDM = do
-  [sid,rid,rscr,sscr,txt,i,cre] <- mapM get  ["sender_id","recipient_id","recipient_screen_name", "sender_screen_name", "text", "id", "created_at"]
+  [sid,rid,rscr,sscr,txt,i,cre] <- 
+     mapM (getDefault "")
+          ["sender_id","recipient_id","recipient_screen_name", "sender_screen_name", "text", "id", "created_at"]
   rec <- getMbJ "recipient"
   sen <- getMbJ "sender"
   return nullDirectMessage
@@ -403,7 +430,7 @@ readRateLimit :: JM RateLimit
 readRateLimit = do
   rs <- getInt "reset_time_in_seconds"
-  rt <- get  "reset_time"
+  rt <- getDefault ""  "reset_time"
   rh <- getInt "remaining_hits"
   rl <- getInt "hourly_limit"
   return nullRateLimit
@@ -453,7 +480,7 @@ 
 readSearchResult :: JM SearchResult
 readSearchResult = do
-  [tx,i,fu,fui,ca] <- mapM get  ["text", "id", "from_user", "from_user_id", "created_at"]
+  [tx,i,fu,fui,ca] <- mapM (getDefault "")  ["text", "id", "from_user", "from_user_id", "created_at"]
   l   <- getMbS "language_code"
   tu  <- getMbS "to_user"
   tui <- getMbS "to_user_id"

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