[Some simplification of JSON handling; twitter support stubbed-in.
prb@mult.ifario.us**20080213184625] {
hunk ./src/Blog/Widgets/Delicious.hs 244
-parse_crufty_json = parse_json . unescape . UTF8.decodeString
-    where
-      parse_json = \s -> case (P.parse J.json "" s) of
-                           Left err -> error . show $ err
-                           Right v -> v
+parse_crufty_json = parse_json . unescape
addfile ./src/Blog/Widgets/JsonUtilities.hs
hunk ./src/Blog/Widgets/JsonUtilities.hs 1
+module Blog.Widgets.JsonUtilities where
+
+import qualified Text.Json as J
+import qualified Data.Map as M
+import qualified Text.ParserCombinators.Parsec as P
+import qualified Codec.Binary.UTF8.String as UTF8
+
+
+parse_json :: String -> J.Value
+parse_json s = case P.parse J.json "" $ UTF8.decodeString s of
+                 Left err -> error . show $ err
+                 Right v -> v
+
+(</>) :: J.Value -> String -> J.Value
+(J.Object o) </> s = o M.! s
+(J.Array a) </> s = J.Array ( map (flip (</>) $ s) a)
+
+blank :: J.Value
+blank = J.String ""
+
+zero :: J.Value
+zero = J.Number 0
+
+empty_object :: J.Value
+empty_object = J.Object M.empty
+
+empty_array :: J.Value
+empty_array = J.Array []
+
+unn :: J.Value -> Int
+unn (J.Number n) = fromInteger . round $ n
+
+uno :: J.Value -> M.Map String J.Value
+uno (J.Object o) = o
+
+una :: J.Value -> [J.Value]
+una (J.Array a) = a
+
+uns :: J.Value -> String
+uns (J.String s) = s
addfile ./src/Blog/Widgets/Twitter.hs
hunk ./src/Blog/Widgets/Twitter.hs 1
-
+module Blog.Widgets.Twitter (boot_twitter, get_tweets) where
+
+import Network.HTTP
+import Network.HTTP.Headers
+import Network.URI
+import Data.Maybe
+import Text.XHtml.Strict
+import Control.Concurrent
+import Control.Concurrent.Chan
+import Control.Concurrent.MVar
+
+import qualified Codec.Binary.Base64.String as B64
+
+import qualified Text.Json as J
+import Blog.Widgets.JsonUtilities
+
+import Blog.BackEnd.HttpPoller
+
+data TRequest = GetTweets { handback :: MVar Html }
+              | UpdateTweets { content :: Html }
+
+data TwitterController = TwitterController { request_channel :: Chan TRequest
+                                           , poller :: HttpPoller
+                                           , twitter_tid :: ThreadId }
+
+boot_twitter :: String -> String -> Int -> IO TwitterController
+boot_twitter user password count = do { let req = build_tweet_request user password count
+                                      ; rc <- newChan
+                                      ; p <- start_poller "Tweets" req (handle_body rc) (60 * 10^6)
+                                      ; tid <- forkIO $ loop rc noHtml
+                                      ; return $ TwitterController rc p tid }
+
+loop :: Chan TRequest -> Html -> IO ()
+loop rc xh = do { req <- readChan rc
+                ; case req of
+                    GetTweets hb ->
+                        putMVar hb xh >> loop rc xh
+                    UpdateTweets xh' ->
+                        loop rc xh' }
+
+build_tweet_request :: String -> String -> Int -> Request
+build_tweet_request user password count = Request uri GET heads ""
+    where 
+      uri = fromJust $ parseURI $ "http://twitter.com/statuses/user_timeline/"
+            ++ user ++ ".json?count=" ++ (show count)
+      heads = [ Header HdrAuthorization $ B64.encode $ user ++ ":" ++ password ]
+
+handle_body :: Chan TRequest -> String -> IO ()
+handle_body tc body = do { let v = parse_json body
+                         ; let texts = map uns $ una $ v </> "text"
+                         ; let times = map uns $ una $ v </> "created_at"
+                         ; update_tweets tc $ to_xhtml $ zip texts times }
+
+send :: TwitterController -> TRequest -> IO ()
+send tc = writeChan (request_channel tc)
+
+update_tweets :: Chan TRequest -> Html -> IO ()
+update_tweets tc tweets = writeChan tc $ UpdateTweets tweets
+
+get_tweets :: TwitterController -> IO Html
+get_tweets tc = do { hb <- newEmptyMVar
+                   ; send tc $ GetTweets hb
+                   ; takeMVar hb }
+
+to_xhtml :: [(String,String)] -> Html
+to_xhtml = stringToHtml . show
}