[Slightly better twitter support. prb@mult.ifario.us**20080214080353] { hunk ./perpubplat.cabal 19 - fastcgi >= 3001.0.0, bytestring >= 0.9, pureMD5 >= 0.1.1 + fastcgi >= 3001.0.0, bytestring >= 0.9, pureMD5 >= 0.1.1, base64-string hunk ./src/Blog/Constants.hs 79 + +twitter_user :: String +twitter_user = "paulrbrown" + +twitter_pass :: String +twitter_pass = "" + +twitter_count :: Int +twitter_count = 10 hunk ./src/Blog/FrontEnd/Presentation.hs 15 +import qualified Blog.Widgets.Twitter as TwC hunk ./src/Blog/FrontEnd/Presentation.hs 109 + ; twc <- TwC.get_tweets $ CB.twitter cb hunk ./src/Blog/FrontEnd/Presentation.hs 115 + , h3 $ stringToHtml "Twitter" + , primHtml twc hunk ./src/Blog/Widgets/ChromeBackEnd.hs 4 -import Blog.Widgets.FlickrCollage (FlickrController, boot_flickr_collage) -import Blog.Widgets.TagCloud (TagCloudController, boot_tag_cloud) -import Blog.Widgets.Delicious (DeliciousController, boot_dc, Scheduler, boot_s, FixedFrequencyDriver, start_driver) +import Blog.Widgets.FlickrCollage (FlickrController, boot_flickr_collage ) +import Blog.Widgets.TagCloud ( TagCloudController, boot_tag_cloud ) +import Blog.Widgets.Delicious ( DeliciousController, boot_dc, Scheduler, boot_s, FixedFrequencyDriver, start_driver) +import Blog.Widgets.Twitter ( TwitterController, boot_twitter ) hunk ./src/Blog/Widgets/ChromeBackEnd.hs 10 +import qualified Blog.Constants as C hunk ./src/Blog/Widgets/ChromeBackEnd.hs 17 - , driver :: FixedFrequencyDriver } + , driver :: FixedFrequencyDriver + , twitter :: TwitterController} hunk ./src/Blog/Widgets/ChromeBackEnd.hs 29 - ; return $ ChromeBackEnd f p t dc s ffd } + ; tc <- boot_twitter C.twitter_user C.twitter_pass C.twitter_count + ; return $ ChromeBackEnd f p t dc s ffd tc } hunk ./src/Blog/Widgets/Delicious.hs 10 -import qualified Codec.Binary.UTF8.String as UTF8 hunk ./src/Blog/Widgets/Delicious.hs 13 -import qualified Text.ParserCombinators.Parsec as P hunk ./src/Blog/Widgets/FlickrCollage.hs 7 -import Text.ParserCombinators.Parsec; hunk ./src/Blog/Widgets/FlickrCollage.hs 19 -import qualified Codec.Binary.UTF8.String as UTF8 hunk ./src/Blog/Widgets/FlickrCollage.hs 85 - json = (parse_json . UTF8.decodeString $ body) + json = parse_json body hunk ./src/Blog/Widgets/FlickrCollage.hs 128 -parse_json :: String -> J.Value -parse_json s = case parse J.json "" s of - Left e -> error $ "Unable to parse JSON response body; error was:\n" ++ (show e) - Right v -> v - hunk ./src/Blog/Widgets/Twitter.hs 1 -module Blog.Widgets.Twitter (boot_twitter, get_tweets) where +module Blog.Widgets.Twitter (boot_twitter, get_tweets, TwitterController ( poller, twitter_tid )) where + +import Text.ParserCombinators.Parsec hunk ./src/Blog/Widgets/Twitter.hs 7 -import Network.URI -import Data.Maybe +import Network.URI ( parseURI ) +import Data.Maybe ( fromJust ) +import Data.List ( elemIndex, intersperse ) hunk ./src/Blog/Widgets/Twitter.hs 17 -import qualified Text.Json as J hunk ./src/Blog/Widgets/Twitter.hs 21 -data TRequest = GetTweets { handback :: MVar Html } - | UpdateTweets { content :: Html } +data TRequest = GetTweets ( MVar String ) + | UpdateTweets String hunk ./src/Blog/Widgets/Twitter.hs 32 - ; tid <- forkIO $ loop rc noHtml + ; tid <- forkIO $ loop rc "" hunk ./src/Blog/Widgets/Twitter.hs 35 -loop :: Chan TRequest -> Html -> IO () +loop :: Chan TRequest -> String -> IO () hunk ./src/Blog/Widgets/Twitter.hs 48 - heads = [ Header HdrAuthorization $ B64.encode $ user ++ ":" ++ password ] + heads = [ Header HdrAuthorization $ (++) "Basic " $ B64.encode $ user ++ ":" ++ password ] hunk ./src/Blog/Widgets/Twitter.hs 53 - ; let times = map uns $ una $ v "created_at" - ; update_tweets tc $ to_xhtml $ zip texts times } + ; let times = map (convert_twitter_tstmp . uns) $ una $ v "created_at" + ; update_tweets tc $ tweets_to_xhtml $ zip texts times } hunk ./src/Blog/Widgets/Twitter.hs 59 -update_tweets :: Chan TRequest -> Html -> IO () +update_tweets :: Chan TRequest -> String -> IO () hunk ./src/Blog/Widgets/Twitter.hs 62 -get_tweets :: TwitterController -> IO Html +get_tweets :: TwitterController -> IO String hunk ./src/Blog/Widgets/Twitter.hs 67 -to_xhtml :: [(String,String)] -> Html -to_xhtml = stringToHtml . show +convert_twitter_tstmp :: String -> String +convert_twitter_tstmp ts = concat [ y, "-", mo', "-", d, "T", tm, "Z" ] + where + mo = take 3 $ drop 4 ts + mo' = pad $ 1 + ( fromJust $ elemIndex mo [ "Jan", "Feb", "Mar", "Apr", "May", "Jun" + , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ] ) + pad = \n -> if n <10 then ('0':show n) else show n + y = take 4 $ drop 26 ts + d = take 2 $ drop 8 ts + tm = take 8 $ drop 11 ts + +tweets_to_xhtml :: [(String,String)] -> String +tweets_to_xhtml = showHtmlFragment . (ulist ! [ identifier "tweets"]) . concatHtml . (map tweet_to_xhtml) + +tweet_to_xhtml :: (String, String) -> Html +tweet_to_xhtml (txt,tstmp) = (li ! [ theclass "tweet" ]) $ (wrap "tweet_stamp" $ stringToHtml tstmp) + +++ (stringToHtml " ") +++ (wrap "tweet_text" $ primHtml . pre_process $ txt) + where + wrap st = (thespan ! [ theclass st ]) + +pre_process :: String -> String +pre_process s = case parse pre_process_parser "" s of + Left err -> error . show $ err + Right v -> v + + +pre_process_parser :: Parser String +pre_process_parser = do { ts <- tok `sepBy` (many1 space) + ; return $ concat . (intersperse " ") $ ts } + +tok :: Parser String +tok = try http_link <|> try at_someone <|> word + +word :: Parser String +word = many1 $ noneOf " " + +at_someone :: Parser String +at_someone = do { char '@' + ; s <- many1 $ noneOf " " + ; return $ "@" ++ s ++ "" } + +http_link :: Parser String +http_link = do { string "http://" + ; s <- many1 $ noneOf " " + ; return $ "" ++ s ++ "" } }