packages feed

bamboo 2009.5.13 → 2009.5.18

raw patch · 15 files changed

+107/−26 lines, 15 filesdep +tokyocabinet-haskell

Dependencies added: tokyocabinet-haskell

Files

bamboo.cabal view
@@ -1,5 +1,5 @@ Name:                 bamboo-Version:              2009.5.13+Version:              2009.5.18 Build-type:           Simple Synopsis:             A simple blog middleware on hack Description:          A simple blog middleware on hack@@ -15,7 +15,7 @@  library   ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-type-defaults-  build-depends: base, cgi, network, haskell98, old-locale, old-time, time, unix, bytestring, base64-string, zlib, directory, filepath, containers, process,parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, utf8-string >= 0.3.3, pandoc, parsec >= 2, gravatar >= 0.3, data-default >= 0.2,  mps >= 2009.5.13, hcheat >= 2009.5.13, hack >= 2009.4.52, hack-contrib >= 2009.5.13+  build-depends: base, cgi, network, haskell98, old-locale, old-time, time, unix, bytestring, base64-string, zlib, directory, filepath, containers, process,parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, utf8-string >= 0.3.3, pandoc, parsec >= 2, gravatar >= 0.3, data-default >= 0.2,  mps >= 2009.5.13, hcheat >= 2009.5.13, hack >= 2009.4.52, hack-contrib >= 2009.5.13, tokyocabinet-haskell >= 0.0.5   hs-source-dirs: src/   exposed-modules:                       Bamboo
changelog.md view
@@ -1,3 +1,12 @@+2009.5.18+---------++### Feature++* use tokyocabinet for caching+* put `use_cache = y` in `site.txt` to enable+* cache db will be in `db/cache`+ 2009.5.13 ---------
src/Bamboo/Config/Global.hs view
@@ -29,6 +29,8 @@ static_id      = "static" topic_id       = "forum/post" thumb_id       = "thumb"+stat_id        = "stat"+cache_id       = "cache"  db_uri         = db_id flat_uri       = db_uri / flat_id@@ -45,6 +47,8 @@  album_uri      = image_uri / album_id topic_uri      = flat_uri / topic_id+stat_uri       = flat_uri / stat_id+cache_uri      = flat_uri / cache_id  data ConfigData =      BlogTitle@@ -72,6 +76,7 @@   | SummaryForRss   | PicturePrefix   | NumberOfLatestPosts+  | UseCache   deriving (Show)    -- unsafe, must restart server after changing config file, sorry about that ...@@ -112,7 +117,7 @@  -- extensions analytics_account_id = for AnalyticsAccountId-extensions           = for_list' Extensions "search, comment, analytics" .read_data_list :: [Extension]+extensions           = for_list' Extensions "search, comment, analytics, counter" .read_data_list :: [Extension]  -- theme default_theme   = def@@ -144,3 +149,8 @@ -- latest number_of_latest_posts = for_int' NumberOfLatestPosts "15" +-- count+count_meta = "count.meta"++-- cache+use_cache = for UseCache .parse_boolean
src/Bamboo/Controller/Application.hs view
@@ -18,6 +18,7 @@ import qualified Bamboo.Type.State as S import qualified Bamboo.Config.Global as G import qualified Bamboo.Type.Pager as Pager+import Bamboo.Type.Cache import Bamboo.Type.Extension import Hack import Hack.Contrib.Response (redirect)@@ -27,6 +28,7 @@ import qualified Bamboo.Model.Static as Static import qualified Bamboo.Model.Tag as Tag import qualified Bamboo.Model.Comment as Comment+import qualified Bamboo.Model.Counter as Counter  -- view import qualified Bamboo.View.Control.Post as PostV@@ -73,14 +75,24 @@   let state = s { S.uid = G.post_id, S.tags = tags, S.pager = p, S.nav_location = nav }      -- output_html "hi"-  posts.mapM (init_post tags) ^ PostV.list state >>= output_html+  posts.for_current_page p .mapM (init_post tags) +    >>= cache g (f state)+    >>= output_plain_html+  where+    g = Post.etag_post_list+    f state = PostV.list state > show > return  index_feed _ = do   posts <- list-  posts.RSSV.rss "" "" .output_html+  posts.take G.number_of_latest_posts .cache g f+    >>= output_plain_html+  where+    g = Post.etag_post_list+    f xs = xs.RSSV.rss "" "" .show.return  blog env = do   let id = env .uri .Post.uri_to_id+  if has_extension Counter then Counter.hit id else return ()   blog <- get id   comments <- list_for id   tags <- tag_list@@ -88,7 +100,12 @@   test_data <- S.mk_human_test   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) ^ PostV.view state comments >>= output_html+  blog.init_post tags +    >>= cache g (f state comments)+    >>= output_plain_html+  where+    g = Post.etag_post+    f state comments x = x.return ^ PostV.view state comments ^ show  static env = do   let id = env.uri@@ -112,8 +129,13 @@       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.TagV.view state.output_html-      +      posts.for_current_page p .return+        >>= cache g (f state)+        >>= output_plain_html+      where+        g = Post.etag_post_list+        f state xs = xs.TagV.view state.show.return+         tag_feed env = do   let id = env .uri .split "/" .init .join "/"   tags <- tag_list@@ -122,7 +144,10 @@     Nothing -> not_found     Just post_set -> do       posts <- post_set.to_list.rsort.mapM get ^ map (Tag.fill_tag tags)-      posts.RSSV.rss G.tag_id tag_name .output_html+      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                  search env = do   let s = env.param_with_default "s" ""
src/Bamboo/Helper/Env.hs view
@@ -21,6 +21,7 @@   , module System.Directory   , module Data.Foldable   , module Data.Default+  , module Hack.Contrib.Utils ) where  import Bamboo.Helper.PreludeEnv hiding (FilePath)@@ -40,4 +41,4 @@ import System.Directory import Data.Foldable (find) import Data.Default-+import Hack.Contrib.Utils (httpdate)
src/Bamboo/Helper/Helper.hs view
@@ -22,6 +22,7 @@ import qualified Prelude as P import Data.Default import System.Directory+import System.IO as IO import Hack import qualified Hack.Contrib.Request as Request import Hack.Contrib.Response@@ -105,13 +106,15 @@ div_class_id x y = thediv ! [theclass x, id y]  xml_header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"-output_html x = +output_html = show > output_plain_html++output_plain_html x =    def      .set_status 200-    .set_body (x.show.unescape_unicode_xml.u2b)+    .set_body (x.unescape_unicode_xml.u2b)     .set_content_type _TextHtmlUTF8     .return-+     spaced_url = gsub "/" " / "  empty_html = toHtml ""@@ -127,6 +130,8 @@ ifM p t f  = p >>= (\p' -> if p' then t else f) parse_boolean = belongs_to ["true", "1", "y", "yes", "yeah"] mkdir = u2b > createDirectory+take_directory = u2b > takeDirectory > b2u+with_file s m f = IO.withFile (s.u2b) m f  -- class class DataRenderer a where@@ -175,5 +180,4 @@  class FlatRead a where   flat_read :: String -> IO a-
src/Bamboo/Helper/StateHelper.hs view
@@ -5,7 +5,7 @@  module Bamboo.Helper.StateHelper where -import Bamboo.Helper.Env+import Bamboo.Helper.Env hiding (path) import qualified Bamboo.Config.Global as G  -- G.root = /blog@@ -48,3 +48,10 @@  -- model path id = G.flat_uri / id+id_to_path = path++etag_data id = do+  let path = id.id_to_path+  mtime <- path.file_mtime ^ httpdate+  size <- path.file_size ^ show+  return $ [id, mtime, size] .join ","
src/Bamboo/Model/Helper.hs view
@@ -3,13 +3,15 @@ module Bamboo.Model.Helper where  import Bamboo.Helper.Env+import Bamboo.Helper.StateHelper import qualified Bamboo.Config.Global as G import Bamboo.Type.Reader import Bamboo.Type.Plugin (apply_plugin) -get_body id   = (G.flat_uri / id) .read_file >>= apply_plugin_for_resource id+get_body id   = id.id_to_path .read_file >>= apply_plugin_for_resource id get_reader id = id.take_extension.guess_reader.fromMaybe G.default_reader  apply_plugin_for_resource id   | id.id_to_type.belongs_to [G.post_id, G.static_id] = apply_plugin   | otherwise = return+
src/Bamboo/Model/Post.hs view
@@ -14,6 +14,9 @@ import Bamboo.Helper.StateHelper hiding (uri) import Bamboo.Helper.Helper (date) import Bamboo.Model.Helper+import Bamboo.Type.Extension+import Bamboo.Model.Counter+import qualified Bamboo.Type.Cache as Cache   data Post = Post @@ -23,6 +26,8 @@   , tags :: [String]   , comment_size :: Int   , reader :: Reader+  , count :: Int+  , cache_output :: String   }   deriving (Show, Eq) @@ -40,11 +45,11 @@   uri = uid > id_to_uri  instance Default Post where-  def = Post def def def def def def+  def = Post def def def def def def def def  instance FlatRead Post where   flat_read x = do-    t <- get_body x+    t <- x.Cache.cache etag_data get_body     def {body = t, uid = x} .return  -- CRUD@@ -55,15 +60,29 @@         title = get_title id       , reader = get_reader id       }-      .return+      .fill_stat  instance Listable Post where   list = list_ids >>= mapM get   cheat_list = fast_list +etag_post x' = do+  x <- x'.fill_stat+  let id = x.uid+  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 ","++etag_post_list xs = xs.mapM etag_post ^ join ","+   list_ids = ls G.post_uri ^ rsort ^ map (G.post_id /) fast_list = list_ids ^ map (\x -> def {uid = x, title = x.get_title}) +fill_stat x | has_extension Counter = do+    c <- x.uid.read_stat+    x {count = c} .return+fill_stat x = return x  get_title id  = id.words.tail.unwords.drop_known_extension get_date id   = id.words.first.split "/".last.default_parse_date
src/Bamboo/Model/Tag.hs view
@@ -5,8 +5,10 @@  -- env import Bamboo.Helper.Env hiding (name)+import Bamboo.Helper.StateHelper import qualified Data.Set as S import qualified Bamboo.Config.Global as G+import Bamboo.Type.Cache   data Tag = Tag @@ -21,15 +23,16 @@  -- CRUD instance Gettable Tag where-  get id           = get_resources id ^ Tag id (get_name id)+  get id           = get_resources_set id ^ Tag id (get_name id)  instance Listable Tag where   list             = ls G.tag_uri ^ map (G.tag_id /) >>= mapM get   get_name id      = id.split "/" .tail.join'-get_resources id = (G.flat_uri / id) .read_file-  ^ filter_comment ^ lines ^ map (G.post_id / ) ^ to_set+get_resources id = id.id_to_path.read_file ^ filter_comment++get_resources_set id = id.cache etag_data get_resources ^ lines ^ map (G.post_id / ) ^ to_set  resource_title_from_name x = ("tag" / x) .spaced_url tag_map' xs       = xs . map (name &&& resources) . to_h
src/Bamboo/Type/Extension.hs view
@@ -7,6 +7,7 @@     Comment   | Search   | Analytics+  | Counter   deriving (Show, Read, Eq)
src/Bamboo/View/Atom/Post.hs view
@@ -26,7 +26,7 @@ show_content Full    x = x.markup  -- post could also be a summary-render_summary x = if x.is True then entry Summary else render_data+render_summary flag = if flag then entry Summary else render_data  title_link x              = h2 << hotlink (x.uri) << x.title post_date x               = toHtml $ x.date.format_time "%b %e, %Y"
src/Bamboo/View/Control/Post.hs view
@@ -26,6 +26,6 @@   where comment_view = only_for Comment $ CommentV.list xs +++ CommentV.create state (x.uid.Comment.from_post_id)  -- list view-list state = for_current_page p > map render > p_eval' > (+++ nav p G.root) > page state where +list state = map render > p_eval' > (+++ nav p G.root) > page state where    p = state.State.pager   render = render_summary G.summary_for_root
src/Bamboo/View/Control/Tag.hs view
@@ -12,7 +12,7 @@ import Bamboo.View.Widget.Template  -view state = for_current_page p > map render > p_eval' > (+++ nav p ( G.root / tag_id)) >>> page state where+view state = map render > p_eval' > (+++ nav p ( G.root / tag_id)) >>> page state where   p = state.State.pager   tag_id = state.State.uid   render = render_summary G.summary_for_tag
src/Bamboo/View/Widget/RSS.hs view
@@ -30,7 +30,7 @@ item_uri x = def { uriScheme = "http://", uriPath = host_link (x.uri) } rss_uri x  = def { uriScheme = "http://", uriPath = host_link x } -rss categary s xs = RSS title  (rss_uri link) title channel_rss_template (xs.take 20 .map item_rss_template)+rss categary s xs = RSS title  (rss_uri link) title channel_rss_template (xs.map item_rss_template)   .rssToXML.showXML   where     link = categary / s