[Touched-up delicious support; integrated with rendering. prb@mult.ifario.us**20080204053653] { hunk ./perpubplat.cabal 14 - - hunk ./perpubplat.cabal 18 - old-locale >= 1.0, json >= 0.1, network >= 2.1, - fastcgi >= 3001.0.0, bytestring >= 0.9 + old-locale >= 1.0, json >= 0.1, network >= 2.1, time >= 1.1.2.0, unix >= 2.3, + fastcgi >= 3001.0.0, bytestring >= 0.9, pureMD5 >= 0.1.1 hunk ./src/Blog/Constants.hs 53 -base_url = "http://localhost:7007" +base_url = "http://mult.ifario.us" hunk ./src/Blog/FrontEnd/Presentation.hs 14 +import qualified Blog.Widgets.Delicious as D hunk ./src/Blog/FrontEnd/Presentation.hs 30 + ; phunk <- renderer v cb m $ paged_posts hunk ./src/Blog/FrontEnd/Presentation.hs 41 - phunk = renderer v m $ paged_posts hunk ./src/Blog/FrontEnd/Presentation.hs 143 -renderer :: (V.Viewable v) => v -> B.Model -> [B.Item] -> Html -renderer v _ [] = no_posts $ V.no_posts_message v -renderer v m l = if (V.kind v == V.Single) then - render_post_detail m $ head l - else - render_posts m l +renderer :: (V.Viewable v) => v -> CB.ChromeBackEnd -> B.Model -> [B.Item] -> IO Html +renderer v _ _ [] = return (no_posts $ V.no_posts_message v) +renderer v cb m l = if (V.kind v == V.Single) then + render_post_detail cb m $ head l + else + render_posts cb m l hunk ./src/Blog/FrontEnd/Presentation.hs 155 -render_post_detail :: B.Model -> B.Item -> Html +render_post_detail :: CB.ChromeBackEnd -> B.Model -> B.Item -> IO Html hunk ./src/Blog/FrontEnd/Presentation.hs 160 -render_posts :: B.Model -> [B.Item] -> Html -render_posts m = concatHtml . map (render_ render_comments_as_count m) +render_posts :: CB.ChromeBackEnd -> B.Model -> [B.Item] -> IO Html +render_posts cb m ii = do { rendered_items <- mapM (render_ render_comments_as_count cb m) ii + ; return $ concatHtml rendered_items } hunk ./src/Blog/FrontEnd/Presentation.hs 164 -render_ :: (B.Model -> B.Item -> Html) -> B.Model -> B.Item -> Html -render_ render_comments m i - = ( thediv ( (post_heading m i) - +++ (render_body "entry" i) - +++ (render_tags i) ) - ! [ theclass "entry_wrapper" ] ) - +++ (render_comments m i) +render_ :: (B.Model -> B.Item -> Html) -> CB.ChromeBackEnd -> B.Model -> B.Item -> IO Html +render_ render_comments cb m i + = do { dc <- D.get_chrome (CB.delicious_controller cb) m i + ; return $ ( thediv ( (post_heading m i) + +++ (render_body "entry" i) + +++ (render_tags i) + +++ dc) + ! [ theclass "entry_wrapper" ] ) + +++ (render_comments m i) } hunk ./src/Blog/Widgets/ChromeBackEnd.hs 6 +import Blog.Widgets.Delicious (DeliciousController, boot_dc, Scheduler, boot_s, FixedFrequencyDriver, start_driver) hunk ./src/Blog/Widgets/ChromeBackEnd.hs 12 - , tag_cloud_controller :: TagCloudController } + , tag_cloud_controller :: TagCloudController + , delicious_controller :: DeliciousController + , scheduler :: Scheduler + , driver :: FixedFrequencyDriver } hunk ./src/Blog/Widgets/ChromeBackEnd.hs 23 - ; return $ ChromeBackEnd f p t} + ; dc <- boot_dc + ; s <- boot_s dc m + ; ffd <- start_driver s (10^7) + ; return $ ChromeBackEnd f p t dc s ffd } hunk ./src/Blog/Widgets/Delicious.hs 11 +import List ( intersperse ) hunk ./src/Blog/Widgets/Delicious.hs 16 -import Control.Concurrent ( forkIO, myThreadId, ThreadId, threadDelay ) +import Control.Concurrent ( forkIO, myThreadId, ThreadId, threadDelay, killThread ) hunk ./src/Blog/Widgets/Delicious.hs 24 +import Blog.FrontEnd.ContentAtoms +import Text.XHtml.Strict + +get_chrome :: DeliciousController -> B.Model -> B.Item -> IO Html +get_chrome dc _ i = do { (_,h) <- get_record dc $ B.internal_id i + ; return $ h } + +to_html :: DeliciousRecord -> B.Model -> B.Item -> Html +to_html dr m i = thediv ! [ theclass "delicious_chrome" ] $ concatHtml + [ if dr == empty_record then + noHtml + else + p $ concatHtml [ _at (url_for_bookmark dr) "Bookmarked" + , stringToHtml $ " by " ++ (show $ total_posts dr) ++ " people: " + , concatHtml . intersperse (stringToHtml ", ") $ map tag_link_with_count (top_tags dr) + ] + , p $ concatHtml [ _at (post_to_delicious plink title) "Bookmark" + , stringToHtml " this post on " + , delicious_img + , _at "http://del.icio.us" "del.icio.us" + , stringToHtml "." ] + ] + where + plink = B.permalink m i + title = B.title i + +tag_link_with_count :: (String, Int) -> Html +tag_link_with_count (t,c) = concatHtml [ _at (link_for_tag t) t + , stringToHtml $ " (" ++ (show c) ++ ")" ] + +link_for_tag :: String -> String +link_for_tag t = "http://del.icio.us/popular/" ++ (urlEncode t) + +post_to_delicious :: String -> String -> String +post_to_delicious url title = "http://del.icio.us/post?v=4&url=" ++ (urlEncode url) ++ "&title=" + ++ (urlEncode $ strip title) +strip = id + +url_for_bookmark :: DeliciousRecord -> String +url_for_bookmark dr = "http://del.icio.us/url/" ++ ( hash dr ) + +delicious_img :: Html +delicious_img = image ! [ src "http://images.del.icio.us/static/img/delicious.small.gif" + , alt "del.icio.us logo" + , theclass "delicious_logo_badge" ] + hunk ./src/Blog/Widgets/Delicious.hs 76 - hunk ./src/Blog/Widgets/Delicious.hs 89 - (map (\x -> e+(5*(fromIntegral x))) [1..(length $ B.all_posts m)]) + (map (\x -> e+(2*(fromIntegral x))) [1..(length $ B.all_posts m)]) hunk ./src/Blog/Widgets/Delicious.hs 99 -type DeliciousState = M.Map Int DeliciousRecord +type DeliciousState = M.Map Int (DeliciousRecord,Html) hunk ./src/Blog/Widgets/Delicious.hs 101 -data DRequest = GetDRecord { callback :: MVar DeliciousRecord +data DRequest = GetDRecord { callback :: MVar (DeliciousRecord,Html) hunk ./src/Blog/Widgets/Delicious.hs 104 - , record :: DeliciousRecord } + , record :: (DeliciousRecord,Html)} hunk ./src/Blog/Widgets/Delicious.hs 116 -get_record :: DeliciousController -> Int -> IO DeliciousRecord +get_record :: DeliciousController -> Int -> IO (DeliciousRecord,Html) hunk ./src/Blog/Widgets/Delicious.hs 121 -put_record :: DeliciousController -> Int -> DeliciousRecord -> IO () -put_record dc i r = writeChan ( d_request_channel dc) $ PutDRecord i r +put_record :: DeliciousController -> Int -> (DeliciousRecord,Html) -> IO () +put_record dc i (r,h) = writeChan ( d_request_channel dc) $ PutDRecord i (r,h) hunk ./src/Blog/Widgets/Delicious.hs 131 - do { putMVar cb $ M.findWithDefault empty_record ii ds + do { putMVar cb $ M.findWithDefault (empty_record,noHtml) ii ds hunk ./src/Blog/Widgets/Delicious.hs 133 - PutDRecord ii r -> - dc_loop dc $ M.insert ii r ds + PutDRecord ii (r,h) -> + dc_loop dc $ M.insert ii (r,h) ds hunk ./src/Blog/Widgets/Delicious.hs 137 +data FixedFrequencyDriver = FixedFrequencyDriver { target_scheduler :: Scheduler + , delay :: Int + , ffd_tid :: ThreadId } + +start_driver :: Scheduler -> Int -> IO FixedFrequencyDriver +start_driver s i = do { t <- myThreadId + ; let ffd = FixedFrequencyDriver s i t + ; tid <- forkIO $ ffd_loop ffd + ; return ffd { ffd_tid = tid } } + +kill_driver :: FixedFrequencyDriver -> IO () +kill_driver = killThread . ffd_tid + +ffd_loop :: FixedFrequencyDriver -> IO () +ffd_loop ffd = do { fire $ target_scheduler ffd + ; threadDelay $ delay ffd + ; ffd_loop ffd } + hunk ./src/Blog/Widgets/Delicious.hs 168 - ; let next_actions' = insert (t1,i) (drop 1 $ next_actions s) + ; let next_actions' = insert (t1,i) ts hunk ./src/Blog/Widgets/Delicious.hs 185 - ; put_record dc (B.internal_id item) dr + ; put_record dc (B.internal_id item) (dr,to_html dr m item) hunk ./src/Blog/Widgets/Delicious.hs 190 - ; return $ n + 60 } + ; return $ n + fromIntegral (60 * (t+1)) } hunk ./src/Blog/Widgets/Delicious.hs 212 - Right res@(Response (2,0,0) _ _ body) -> + Right (Response (2,0,0) _ _ body) -> }