packages feed

bamboo 2009.5.22 → 2009.5.23

raw patch · 18 files changed

+136/−66 lines, 18 files

Files

bamboo.cabal view
@@ -1,5 +1,5 @@ Name:                 bamboo-Version:              2009.5.22+Version:              2009.5.23 Build-type:           Simple Synopsis:             A simple blog middleware on hack Description:          A simple blog middleware on hack@@ -30,7 +30,8 @@                     Bamboo.Helper.Env                     Bamboo.Helper.PreludeEnv                     Bamboo.Helper.ThumbHelper-+                    Bamboo.Helper.ByteString+                                         Bamboo.Model.Tag                     Bamboo.Model.Post                     Bamboo.Model.Helper
changelog.md view
@@ -1,3 +1,16 @@+2009.5.23+---------++### Feature++* cached posts / static page for performance+* cached most IO+* use bytestring for performance ( 1.8 x increase )++### Fix++* properly update etag key for page, when tags are updated+ 2009.5.22 ---------
readme.md view
@@ -82,9 +82,8 @@ ### 3. Run      mkdir myblog-    bamboo-launcher--It should be running on [http://127.0.0.1:3000](http://127.0.0.1:3000) now.+    cd myblog+    bamboo  ## Links
src/Bamboo/Controller/Application.hs view
@@ -37,13 +37,14 @@ import qualified Bamboo.View.Control.Search as SearchV import qualified Bamboo.View.Widget.RSS as RSSV +import qualified Data.ByteString.Lazy.Char8 as L + -- helpers blog_regex       = G.url_date_matcher init_post tags x = x.Tag.fill_tag tags.Comment.fill_comment_size tag_list         = list - -- main controller paths =    [ ("$"                  ,index                                  )@@ -60,7 +61,6 @@  only_for ext x = if has_extension ext then x else const not_found - default_state = do   latest_posts <- Post.latest G.number_of_latest_posts   def { S.latest_posts = latest_posts } .return@@ -76,10 +76,11 @@      -- output_html "hi"   posts.for_current_page p .mapM (init_post tags) -    >>= cache g (f state)+    >>= cache (g tags) (f state)     >>= output_plain_html   where-    g = Post.etag_post_list+    g tags xs = liftM2 L.append +      (Post.etag_post_list xs) (Tag.etag_tag_list tags)     f state = PostV.list state > render_html > return  index_feed _ = do@@ -88,7 +89,7 @@     >>= output_plain_html   where     g = Post.etag_post_list-    f xs = xs.RSSV.rss "" "" .show.return+    f xs = xs.RSSV.rss "" "" .show.u2bs.return  blog env = do   let id = env .uri .Post.uri_to_id@@ -101,10 +102,11 @@   s <- default_state   let state = s { S.uid = id, S.tags = tags, S.resource_title = blog.resource_title, S.human_test_data = test_data }   blog.init_post tags -    >>= cache g (f state comments)+    >>= cache (g tags) (f state comments)     >>= output_plain_html   where-    g = Post.etag_post+    g tags x = liftM2 L.append +      (Post.etag_post x) (Tag.etag_tag_list tags)     f state comments x = x.return ^ PostV.view state comments ^ render_html  static env = do@@ -115,7 +117,11 @@   let nav   = if nav_id.belongs_to G.navigation then nav_id else no_navigation   s <- default_state   let state = s { S.uid = id, S.tags = tags, S.nav_location = nav, S.resource_title = static_page.resource_title }-  StaticV.view state static_page .output_html+  static_page.cache (g tags) (f state) >>= output_plain_html+  where+    g tags x = liftM2 L.append +      (etag_data (x.Static.uid)) (Tag.etag_tag_list tags)+    f state x = x.return ^ StaticV.view state ^ render_html   tag env = do@@ -125,15 +131,16 @@   case Tag.tag_map' tags .Map.lookup tag_name of     Nothing -> not_found     Just post_set -> do-      posts <- post_set.to_list.rsort.mapM (get) >>= mapM (init_post tags)+      posts <- post_set.to_list.rsort.mapM (bs2u > get) >>= mapM (init_post tags)       let p = posts.paginate env       s <- default_state       let state = s { S.uid = id, S.tags = tags, S.pager = p, S.resource_title = tag_name.Tag.resource_title_from_name }       posts.for_current_page p .return-        >>= cache g (f state)+        >>= cache (g tags) (f state)         >>= output_plain_html       where-        g = Post.etag_post_list+        g tags xs = liftM2 L.append +          (Post.etag_post_list xs) (Tag.etag_tag_list tags)         f state xs = xs.TagV.view state.render_html.return          tag_feed env = do@@ -143,11 +150,11 @@   case Tag.tag_map' tags .Map.lookup tag_name of     Nothing -> not_found     Just post_set -> do-      posts <- post_set.to_list.rsort.mapM get ^ map (Tag.fill_tag tags)+      posts <- post_set.to_list.rsort.mapM (bs2u > get) ^ map (Tag.fill_tag tags)       posts.take (G.number_of_latest_posts). cache g f >>= output_plain_html       where         g = Post.etag_post_list-        f xs = xs.RSSV.rss G.tag_id tag_name.show.return+        f xs = xs.RSSV.rss G.tag_id tag_name.show.u2bs.return                  search env = do   let s = env.param_with_default "s" ""
+ src/Bamboo/Helper/ByteString.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE NoMonomorphismRestriction#-}+{-# LANGUAGE NoImplicitPrelude #-}++module Bamboo.Helper.ByteString where++import Data.Char (toLower)+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.UTF8 as U+import qualified Data.ByteString.Char8 as S+import Bamboo.Helper.PreludeEnv++l2s = L.toChunks > S.concat+s2l = return > L.fromChunks++lower = L.map toLower+bs2u = l2s > U.toString+u2bs = U.fromString > s2l++isInfixOf a b = S.isInfixOf (a.l2s) (b.l2s)++read_bytestring = u2b > L.readFile
src/Bamboo/Helper/Env.hs view
@@ -22,6 +22,8 @@   , module Data.Foldable   , module Data.Default   , module Hack.Contrib.Utils+  , module Data.ByteString.Lazy.Char8 +  , module Bamboo.Helper.ByteString ) where  import Bamboo.Helper.PreludeEnv hiding (FilePath)@@ -42,3 +44,5 @@ import Data.Foldable (find) import Data.Default import Hack.Contrib.Utils (httpdate)+import Data.ByteString.Lazy.Char8 (pack, unpack)+import Bamboo.Helper.ByteString hiding (lower, isInfixOf)
src/Bamboo/Helper/Helper.hs view
@@ -28,7 +28,8 @@ import Hack.Contrib.Response import Hack.Contrib.Constants import Hack.Contrib.Utils-import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as L+import Bamboo.Helper.ByteString  gt = (P.>) @@ -108,13 +109,13 @@ div_class_id x y = thediv ! [theclass x, id y]  xml_header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"-render_html = renderHtml+render_html = renderHtml > unescape_unicode_xml > u2bs output_html = render_html > output_plain_html  output_plain_html x =    def      .set_status 200-    .set_body (x.unescape_unicode_xml.u2b.B.pack)+    .set_body x     .set_content_type _TextHtmlUTF8     .return     @@ -184,3 +185,5 @@ class FlatRead a where   flat_read :: String -> IO a +instance Default L.ByteString where+  def = L.empty
src/Bamboo/Helper/PreludeEnv.hs view
src/Bamboo/Helper/StateHelper.hs view
@@ -7,6 +7,7 @@  import Bamboo.Helper.Env hiding (path) import qualified Bamboo.Config.Global as G+import qualified Data.ByteString.Lazy.Char8 as L  -- G.root = /blog -- raw_uri = blog/x@@ -37,9 +38,9 @@ -- controller paginate env xs = full_paginate (G.per_page) (xs.length) env -cut       = G.cut-match_cut = isInfixOf cut-is_cut    = isPrefixOf cut+cut       = G.cut.u2bs+match_cut = L.lines > any (L.isPrefixOf cut)+is_cut    = L.isPrefixOf cut  -- not used for efficiency -- cut_re    = "^\\s*" ++ cut@@ -54,4 +55,4 @@   let path = id.id_to_path   mtime <- path.file_mtime ^ httpdate   size <- path.file_size ^ show-  return $ [id, mtime, size] .join ","+  return $ [id, mtime, size] .join "," .pack
src/Bamboo/Model/Comment.hs view
@@ -9,11 +9,12 @@ import qualified Bamboo.Model.Post as Post import Bamboo.Helper.StateHelper import Network.Gravatar+import qualified Data.ByteString.Lazy.Char8 as L  data Comment = Comment   { uid    :: String     -- comment/08-09-04 blog title   , author :: String-  , body   :: String+  , body   :: L.ByteString   , author_email :: String   , author_link    :: String   }@@ -50,7 +51,7 @@ -- CRUD instance FlatRead Comment where   flat_read x = do-    t <- x.path.read_file+    t <- x.path.read_bytestring     def {body = t, uid = x} .return  instance Gettable Comment where@@ -86,7 +87,7 @@     let uid  = comment_path / timestamp     def        { uid = uid-      , body = at Body+      , body = at Body .u2bs       , author = at Author       , author_email = at AuthorEmail       , author_link = at AuthorLink@@ -94,7 +95,7 @@       .return  write_to x = do-  write_file (x.uid) (x.body)+  L.writeFile (x.uid.u2b) (x.body)   write_config_io (x.uid.meta) meta_data   where     meta_data = 
src/Bamboo/Model/Helper.hs view
@@ -8,7 +8,8 @@ import Bamboo.Type.Reader import Bamboo.Type.Plugin (apply_plugin) -get_body id   = id.id_to_path .read_file >>= apply_plugin_for_resource id+get_body id   = id.id_to_path .read_bytestring >>= +  apply_plugin_for_resource id get_reader id = id.take_extension.guess_reader.fromMaybe G.default_reader  apply_plugin_for_resource id
src/Bamboo/Model/Post.hs view
@@ -17,17 +17,18 @@ import Bamboo.Type.Extension import Bamboo.Model.Counter import qualified Bamboo.Type.Cache as Cache-+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Bamboo.Helper.ByteString as BS+import Data.List (sort)  data Post = Post    { uid :: String     -- blog/08-09-04 blog title   , title :: String-  , body :: String+  , body :: L.ByteString   , tags :: [String]   , comment_size :: Int   , reader :: Reader   , count :: Int-  , cache_output :: String   }   deriving (Show, Eq) @@ -45,7 +46,7 @@   uri = uid > id_to_uri  instance Default Post where-  def = Post def def def def def def def def+  def = Post def def def def def def def  instance FlatRead Post where   flat_read x = do@@ -72,9 +73,9 @@   let path = id.id_to_path   mtime <- path.file_mtime ^ httpdate   size <- path.file_size ^ show-  return $ [id, mtime, size, x.comment_size.show, x.count.show] .join ","+  return $ [id, mtime, size, x.comment_size.show, x.count.show] .join "," .pack -etag_post_list xs = xs.mapM etag_post ^ join ","+etag_post_list xs = xs.mapM etag_post ^ sort ^ L.intercalate (pack ",")    list_ids = ls G.post_uri ^ rsort ^ map (G.post_id /) fast_list = list_ids ^ map (\x -> def {uid = x, title = x.get_title})@@ -87,15 +88,15 @@ get_title id  = id.words.tail.unwords.drop_known_extension get_date id   = id.words.first.split "/".last.default_parse_date -match s x = [title, body] .map (send_to x > lower > isInfixOf (s.lower)) .or+match s x = [title > u2bs, body] .map (send_to x > BS.lower > BS.isInfixOf (s.lower.u2bs)) .or search "" = return [] search s  = list ^ filter (match s) -summary x = x.body.lines.takeWhile (is_cut > not) .unlines+summary x = x.body.L.lines.takeWhile (is_cut > not) .L.unlines full x | x.body.match_cut.not = x.body-full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).unlines where+full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).L.unlines where   not_cut = is_cut > not-  xs = x.body.lines+  xs = x.body.L.lines  has_continue = body > match_cut 
src/Bamboo/Model/Static.hs view
@@ -5,10 +5,13 @@ import Bamboo.Helper.Env hiding (match, body) import Bamboo.Type.Reader import Bamboo.Model.Helper+import qualified Data.ByteString.Lazy.Char8 as L+import Bamboo.Type.Cache+import Bamboo.Helper.StateHelper  data Static = Static    { uid :: String-  , body :: String+  , body :: L.ByteString   , reader :: Reader   }   deriving (Show, Eq)@@ -20,12 +23,12 @@   markup x = render_to_html (x.reader) (x.body)  instance Default Static where-  def = Static def def def+  def = Static def L.empty def  -- CRUD instance FlatRead Static where   flat_read x = do-    t <- get_body x+    t <- x.cache etag_data get_body     def {body = t, uid = x} .return  instance Gettable Static where
src/Bamboo/Model/Tag.hs view
@@ -9,12 +9,14 @@ import qualified Data.Set as S import qualified Bamboo.Config.Global as G import Bamboo.Type.Cache+import Data.List (sort)+import qualified Data.ByteString.Lazy.Char8 as L   data Tag = Tag    { uid :: String     -- tag/name   , name :: String-  , resources :: S.Set String+  , resources :: S.Set L.ByteString   }   deriving (Show, Eq) @@ -28,19 +30,26 @@ instance Listable Tag where   list             = ls G.tag_uri ^ map (G.tag_id /) >>= mapM get +etag_tag_list xs = xs.mapM (uid > etag_data) ^ sort ^ L.intercalate (pack ",")  get_name id      = id.split "/" .tail.join'-get_resources id = id.id_to_path.read_file ^ filter_comment+get_resources id = id.id_to_path.read_bytestring -get_resources_set id = id.cache etag_data get_resources ^ lines ^ map (G.post_id / ) ^ to_set+get_resources_set id = id.cache etag_data get_resources ^ L.lines ^ map (bs_slash $ G.post_id.pack ) ^ to_set +bs_slash x y = L.concat [x, "/".pack, y.L.dropWhile (is '/')]+ resource_title_from_name x = ("tag" / x) .spaced_url tag_map' xs       = xs . map (name &&& resources) . to_h tag_map           = list ^ tag_map' -for_resource xs x = xs.select (resources > has x) .map name+for_resource xs x = xs.select (resources > has (x.u2bs)) .map name fill_tag xs x     = x { Post.tags = for_resource xs (x.Post.uid) }  -- extra-sorted xs    = xs.sortBy(compare_by (resources > S.size)).reverse+sorted xs = +  xs+    .sortBy(compare_by (\x -> (x.resources.S.size, x.name)))+    .reverse+     name_to_id x = G.tag_id / x
src/Bamboo/Type/Cache.hs view
@@ -7,15 +7,15 @@ import qualified Data.ByteString.Char8 as C import qualified Database.TokyoCabinet as TC import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S     -pack = u2b > C.pack-unpack = C.unpack > b2u   cache_file = G.cache_uri -set k v = TC.runTCM $ putsample cache_file [(k.pack, v.pack)]+set k v = TC.runTCM $ putsample cache_file [(k.l2s, v.l2s)] get k = do-  v <- TC.runTCM $ getsample cache_file (k.pack)-  return $ v ^ unpack+  v <- TC.runTCM $ getsample cache_file (k.l2s)+  return $ v ^ s2l  cache g f x =   if G.use_cache @@ -25,7 +25,7 @@ cache'' _ f x = f x  -- etag generator -> value function -> model -> value-cache' :: (a -> IO String) -> (a -> IO String) -> a -> (IO String)+cache' :: (a -> IO L.ByteString) -> (a -> IO L.ByteString) -> a -> (IO L.ByteString) cache' g f x = do   k <- g x   c <- get k
src/Bamboo/Type/Plugin.hs view
@@ -6,6 +6,8 @@ import qualified Bamboo.Model.Video as V import qualified Bamboo.View.Atom.Album as AlbumV () import qualified Bamboo.View.Atom.Video as VV ()+import qualified Bamboo.Helper.ByteString as BS+import qualified Data.ByteString.Lazy.Char8 as L  data PluginType = PhotoAlbum | Video | None deriving (Show, Eq) @@ -26,10 +28,10 @@ plugin_expression = "\n\\[\\[((.|\n)*?)\\]\\]" plugin_id = "plugin" -infix_of = flip isInfixOf+infix_of = flip BS.isInfixOf -optimized_match x -  | "[[".infix_of x = x.match plugin_expression+optimized_match x+  | pack "[[" .infix_of x = x.bs2u.match plugin_expression   | otherwise = Nothing  @@ -46,6 +48,7 @@  match_result x = x.fromJust.snd.first.snd.b2u +apply_plugin :: L.ByteString -> IO L.ByteString apply_plugin x = if r.isNothing then return x else sub_it where   r = x.optimized_match   plugin = r.match_result.parse_plugin@@ -53,9 +56,9 @@     None -> return x     PhotoAlbum -> do        album <- plugin.args.Album.from_list ^ render_plugin-      x.sub plugin_expression album .apply_plugin+      x.bs2u.sub plugin_expression album .u2bs.apply_plugin     Video -> do        video <- plugin.args.V.from_list ^ render_plugin-      x.sub plugin_expression video .apply_plugin+      x.bs2u.sub plugin_expression video .u2bs.apply_plugin  render_plugin x = "\n" ++ x.render_data.show
src/Bamboo/Type/Reader.hs view
@@ -8,6 +8,8 @@  import Text.XHtml.Strict import Data.Default+import qualified Data.ByteString.Lazy.Char8 as L+import Bamboo.Helper.ByteString  data Reader = Markdown | RST | HTML | Latex deriving (Show, Eq) @@ -31,10 +33,10 @@  -- this list can go on, as long as there is a library that does -- the convertion. pretty extensible, isn't it.-rr :: Reader -> String -> Html-rr Markdown    = to_html readMarkdown-rr RST         = to_html readRST-rr HTML        = primHtml-rr Latex       = to_html readLaTeX+rr :: Reader -> L.ByteString -> Html+rr Markdown    = bs2u > to_html readMarkdown+rr RST         = bs2u > to_html readRST+rr HTML        = bs2u > primHtml+rr Latex       = bs2u > to_html readLaTeX  render_to_html = rr
src/Bamboo/Type/StaticWidget.hs view
@@ -3,10 +3,11 @@  import Bamboo.Helper.Env hiding (body) import Bamboo.Type.Reader+import qualified Data.ByteString.Lazy.Char8 as L  data StaticWidget = StaticWidget   { name :: String-  , body :: String+  , body :: L.ByteString   , reader :: Reader   }   deriving (Show, Eq)@@ -15,6 +16,6 @@   markup x  = render_to_html (x.reader) (x.body)  read_static_widget default_reader s = liftM2 (StaticWidget name) body (return reader) where-  body = s.read_file+  body = s.read_bytestring   reader = s.take_extension.guess_reader.fromMaybe default_reader   name = s.takeFileName.drop_known_extension