[Hopefully better error handling for JSON bodies. Need an elegant approach here. prb@mult.ifario.us**20080725052303] { hunk ./servletsrc/perpubplat.hs 10 -import qualified Blog.BackEnd.RefererStream as RefS +-- import qualified Blog.BackEnd.RefererStream as RefS hunk ./servletsrc/perpubplat.hs 34 -import Data.Maybe (fromJust, isJust) +import Data.Maybe (fromJust, {- isJust -}) hunk ./servletsrc/perpubplat.hs 42 - , referer_stream :: RefS.RefererStream + -- , referer_stream :: RefS.RefererStream hunk ./servletsrc/perpubplat.hs 68 -serve_content con v = do { r <- requestHeader "Referer" - ; when (isJust r) $ liftIO $ RefS.send_referer (referer_stream con) v (fromJust r) +serve_content con v = do { -- r <- requestHeader "Referer" + -- ; when (isJust r) $ liftIO $ RefS.send_referer (referer_stream con) v (fromJust r) hunk ./servletsrc/perpubplat.hs 215 - ; rs <- RefS.boot - ; let con = Controllers mh cc cb rs + -- ; rs <- RefS.boot + ; let con = Controllers mh cc cb -- rs hunk ./src/Blog/Widgets/Delicious.hs 214 -url_fragment = "http://badges.del.icio.us/feeds/json/url/data?hash=" +url_fragment = "http://feeds.delicious.com/v2/json/urlinfo/data?hash=" hunk ./src/Blog/Widgets/Delicious.hs 231 - ; res <- simpleHTTP . request_for_url_data $ url + ; let req = request_for_url_data url + ; res <- simpleHTTP req hunk ./src/Blog/Widgets/Delicious.hs 236 + Right r@(Response rc@(3,0,_) reason _ _) -> + do { let location = fromMaybe "" (findHeader HdrLocation r) + ; L.errorM log_handle $ "Received " ++ (show_rc rc) + ++ " response code from del.icio.us for URL " ++ (show $ rqURI req) + ++ " with reason \"" ++ reason ++ "\" and new location " + ++ location ++ "." + ; return Nothing } hunk ./src/Blog/Widgets/Delicious.hs 245 - ++ " response code from delicious with reason " ++ reason + ++ " response code from del.icio.us for URL " + ++ ( show $ rqURI req ) + ++ " with reason: \"" ++ reason ++ "\"." hunk ./src/Blog/Widgets/FlickrCollage.hs 17 +import qualified Control.Exception as CE hunk ./src/Blog/Widgets/FlickrCollage.hs 75 - do { let photos = map to_photo ( una $ v "photos" "photo" ) + ( do { let photos = map to_photo ( una $ v "photos" "photo" ) hunk ./src/Blog/Widgets/FlickrCollage.hs 77 - ; put_photos fc photos } + ; put_photos fc photos } ) + `CE.catch` + (\e -> do { L.errorM log_handle $ "Unable to traverse JSON: " ++ (show e) + ; L.debugM log_handle $ "JSON that caused the error: " ++ body } ) hunk ./src/Blog/Widgets/FlickrCollage.hs 82 - L.errorM log_handle err + do { L.errorM log_handle err + ; L.debugM log_handle $ "JSON that caused the error: " ++ body } hunk ./src/Blog/Widgets/StreamOfConsciousness/Twitter.hs 16 +import qualified Control.Exception as CE hunk ./src/Blog/Widgets/StreamOfConsciousness/Twitter.hs 66 - = case parse_utf8_json body of - Right v@(JSArray _) -> - commit socc $ tweets_to_thoughts user v - Right _ -> - L.errorM (log_handle Tweet) $ "Unexpected non-array JSON response that starts with: " - ++ (take 100 body) ++ " [...]" - Left err_message -> - L.errorM (log_handle Tweet) err_message + = ( case parse_utf8_json body of + Right v@(JSArray _) -> + commit socc $ tweets_to_thoughts user v + Right _ -> + L.errorM (log_handle Tweet) $ "Unexpected non-array JSON response that starts with: " + ++ (take 100 body) ++ " [...]" + Left err_message -> + L.errorM (log_handle Tweet) err_message ) + `CE.catch` + (\e -> do { L.errorM (log_handle Tweet) $ "Unable to traverse JSON: " ++ (show e) + ; L.debugM (log_handle Tweet) $ "JSON that caused the error: " ++ body } ) hunk ./src/Blog/Widgets/StreamOfConsciousness/TwitterNanny.hs 12 +import qualified Control.Exception as CE hunk ./src/Blog/Widgets/StreamOfConsciousness/TwitterNanny.hs 40 -handle_throttle ws body = case parse_utf8_json body of - Right v@(JSObject _) -> - compute_new_delays ws v - Right _ -> - L.errorM log_handle $ "Unexpected non-object JSON response that starts with: " - ++ (take 100 body) ++ " [...]" - Left err_message -> - L.errorM log_handle err_message +handle_throttle ws body = ( case parse_utf8_json body of + Right v@(JSObject _) -> + compute_new_delays ws v + Right _ -> + L.errorM log_handle $ "Unexpected non-object JSON response that starts with: " + ++ (take 100 body) ++ " [...]" + Left err_message -> + L.errorM log_handle err_message ) + `CE.catch` + (\e -> do { L.errorM log_handle $ "Unable to traverse JSON: " ++ (show e) + ; L.debugM log_handle $ "JSON that caused the error: " ++ body } ) + }