[Some cleanup and simplification. prb@mult.ifario.us**20080218201435] { hunk ./src/Blog/FrontEnd/Presentation.hs 107 - do { fc <- FC.build_collage $ CB.flickr_controller cb + do { fc <- FC.build_collage $ CB.flickr_collage cb hunk ./src/Blog/Widgets/ChromeBackEnd.hs 4 -import Blog.Widgets.FlickrCollage (FlickrController, boot_flickr_collage ) +import Blog.Widgets.FlickrCollage ( FlickrPhotos, boot_flickr_collage ) hunk ./src/Blog/Widgets/ChromeBackEnd.hs 8 -import Blog.BackEnd.HttpPoller hunk ./src/Blog/Widgets/ChromeBackEnd.hs 11 -data ChromeBackEnd = ChromeBackEnd { flickr_controller :: FlickrController - , flickr_poller :: HttpPoller +data ChromeBackEnd = ChromeBackEnd { flickr_collage :: FlickrPhotos hunk ./src/Blog/Widgets/ChromeBackEnd.hs 22 -boot m = do { (f,p) <- boot_flickr_collage C.flickr_user C.flickr_api_key +boot m = do { f <- boot_flickr_collage C.flickr_user C.flickr_api_key hunk ./src/Blog/Widgets/ChromeBackEnd.hs 31 - ; return $ ChromeBackEnd f p t dc s ffd socc } + ; return $ ChromeBackEnd f t dc s ffd socc } hunk ./src/Blog/Widgets/FlickrCollage.hs 14 -import Control.Concurrent hunk ./src/Blog/Widgets/FlickrCollage.hs 15 -import Control.Concurrent.Chan hunk ./src/Blog/Widgets/FlickrCollage.hs 20 -build_collage :: FlickrController -> IO Html -build_collage fc = do { images <- get_photos fc +build_collage :: FlickrPhotos -> IO Html +build_collage fp = do { images <- get_photos fp hunk ./src/Blog/Widgets/FlickrCollage.hs 24 - . concatHtml $ [ concatHtml . (map (to_xhtml $ flickr_user fc)) $ images + . concatHtml $ [ concatHtml . (map (to_xhtml $ flickr_user fp)) $ images hunk ./src/Blog/Widgets/FlickrCollage.hs 47 -data FRequest = Put { photo_urls :: [FlickrPhoto] } | Get { callback :: MVar [FlickrPhoto]} - -data FlickrController = FlickrController { request_channel :: Chan FRequest - , flickr_user :: String - , fc_tid :: ThreadId} +data FlickrPhotos = FlickrPhotos { box :: MVar [FlickrPhoto] + , poller :: HttpPoller + , flickr_user :: String } hunk ./src/Blog/Widgets/FlickrCollage.hs 59 -boot_flickr_collage :: String -> String -> IO (FlickrController, HttpPoller) +boot_flickr_collage :: String -> String -> IO FlickrPhotos hunk ./src/Blog/Widgets/FlickrCollage.hs 61 - do { temp_tid <- myThreadId - ; rc <- newChan - ; let fc = FlickrController rc user_id temp_tid - ; ftid <- forkIO (run_loop fc []) + do { box <- newMVar [] hunk ./src/Blog/Widgets/FlickrCollage.hs 63 - (handle_flickr_response fc) polling_frequency - ; return (fc { fc_tid = ftid}, p) } + (handle_flickr_response box) polling_frequency + ; return $ FlickrPhotos box p user_id} hunk ./src/Blog/Widgets/FlickrCollage.hs 66 -handle_flickr_response :: FlickrController -> String -> IO () +handle_flickr_response :: MVar [FlickrPhoto] -> String -> IO () hunk ./src/Blog/Widgets/FlickrCollage.hs 75 -run_loop :: FlickrController -> [FlickrPhoto] -> IO () -run_loop fc photos = do { req <- readChan $ request_channel fc - ; case req of - Put photos' -> - run_loop fc photos' - Get cb -> - do { putMVar cb photos - ; run_loop fc photos } - } - -get_photos :: FlickrController -> IO [FlickrPhoto] -get_photos fc = do { cb <- newEmptyMVar - ; writeChan (request_channel fc) $ Get cb - ; photos <- takeMVar cb +get_photos :: FlickrPhotos -> IO [FlickrPhoto] +get_photos fp = do { photos <- readMVar $ box fp hunk ./src/Blog/Widgets/FlickrCollage.hs 85 -put_photos :: FlickrController -> [FlickrPhoto] -> IO () -put_photos fc photos = writeChan (request_channel fc) $ Put photos +put_photos :: MVar [FlickrPhoto] -> [FlickrPhoto] -> IO () +put_photos box photos = swapMVar box photos >> return () hunk ./src/Blog/Widgets/JsonUtilities.hs 16 -(J.Array a) s = J.Array ( map (flip () $ s) a) +(J.Array a) s = J.Array $ map (flip () $ s) a hunk ./src/Blog/Widgets/StreamOfConsciousness/Controller.hs 59 -commit socc new_items = do { snap <- get_data socc - ; let items' = take (max_size snap) $ merge new_items $ items snap - ; let rendered' = thoughts_to_xhtml items' - ; let snap' = snap { items = items' - , rendered = rendered' } - ; ok <- update socc snap' - ; if ok then - return () - else - do { threadDelay collision_delay - ; commit socc new_items } - } +commit socc new_items = + do { snap <- get_data socc + ; let items' = take (max_size snap) $ merge new_items $ items snap + ; let rendered' = thoughts_to_xhtml items' + ; let snap' = snap { items = items' + , rendered = rendered' } + ; ok <- update socc snap' + ; if ok then + return () + else + do { threadDelay collision_delay + ; commit socc new_items } + } }