packages feed

bamboo 2009.5.23 → 2009.5.27

raw patch · 16 files changed

+125/−70 lines, 16 files

Files

bamboo.cabal view
@@ -1,5 +1,5 @@ Name:                 bamboo-Version:              2009.5.23+Version:              2009.5.27 Build-type:           Simple Synopsis:             A simple blog middleware on hack Description:          A simple blog middleware on hack
changelog.md view
@@ -1,3 +1,11 @@+2009.5.27+---------++### Fix++* content-type for rss set to "application/rss+xml"+* use strict bytestring in IO to release handle eagarly+ 2009.5.23 ---------
src/Bamboo/Controller/Application.hs view
@@ -37,7 +37,7 @@ import qualified Bamboo.View.Control.Search as SearchV import qualified Bamboo.View.Widget.RSS as RSSV -import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S   -- helpers@@ -79,17 +79,17 @@     >>= cache (g tags) (f state)     >>= output_plain_html   where-    g tags xs = liftM2 L.append +    g tags xs = liftM2 S.append        (Post.etag_post_list xs) (Tag.etag_tag_list tags)     f state = PostV.list state > render_html > return  index_feed _ = do   posts <- list   posts.take G.number_of_latest_posts .cache g f-    >>= output_plain_html+    >>= output_plain_rss   where     g = Post.etag_post_list-    f xs = xs.RSSV.rss "" "" .show.u2bs.return+    f xs = xs.RSSV.rss "" "" .render_rss.to_sb.return  blog env = do   let id = env .uri .Post.uri_to_id@@ -105,7 +105,7 @@     >>= cache (g tags) (f state comments)     >>= output_plain_html   where-    g tags x = liftM2 L.append +    g tags x = liftM2 S.append        (Post.etag_post x) (Tag.etag_tag_list tags)     f state comments x = x.return ^ PostV.view state comments ^ render_html @@ -119,7 +119,7 @@   let state = s { S.uid = id, S.tags = tags, S.nav_location = nav, S.resource_title = static_page.resource_title }   static_page.cache (g tags) (f state) >>= output_plain_html   where-    g tags x = liftM2 L.append +    g tags x = liftM2 S.append        (etag_data (x.Static.uid)) (Tag.etag_tag_list tags)     f state x = x.return ^ StaticV.view state ^ render_html @@ -131,7 +131,7 @@   case Tag.tag_map' tags .Map.lookup tag_name of     Nothing -> not_found     Just post_set -> do-      posts <- post_set.to_list.rsort.mapM (bs2u > get) >>= mapM (init_post tags)+      posts <- post_set.to_list.rsort.mapM (to_us > 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 }@@ -139,7 +139,7 @@         >>= cache (g tags) (f state)         >>= output_plain_html       where-        g tags xs = liftM2 L.append +        g tags xs = liftM2 S.append            (Post.etag_post_list xs) (Tag.etag_tag_list tags)         f state xs = xs.TagV.view state.render_html.return         @@ -150,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 (bs2u > get) ^ map (Tag.fill_tag tags)-      posts.take (G.number_of_latest_posts). cache g f >>= output_plain_html+      posts <- post_set.to_list.rsort.mapM (to_us > get) ^ map (Tag.fill_tag tags)+      posts.take (G.number_of_latest_posts). cache g f >>= output_plain_rss       where         g = Post.etag_post_list-        f xs = xs.RSSV.rss G.tag_id tag_name.show.u2bs.return+        f xs = xs.RSSV.rss G.tag_id tag_name.render_rss.to_sb.return                  search env = do   let s = env.param_with_default "s" ""
src/Bamboo/Helper/ByteString.hs view
@@ -1,21 +1,61 @@ {-# LANGUAGE NoMonomorphismRestriction#-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeSynonymInstances #-}  module Bamboo.Helper.ByteString where  import Data.Char (toLower)-import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S 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+import qualified Data.ByteString as SB+import qualified Data.ByteString.UTF8 as SU+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Lazy.UTF8 as LU -isInfixOf a b = S.isInfixOf (a.l2s) (b.l2s)+import qualified Prelude as P -read_bytestring = u2b > L.readFile+class SB a where+    to_sb :: a -> SB.ByteString++instance SB SB.ByteString where+    to_sb = P.id++instance SB LB.ByteString where+    to_sb = LB.toChunks > SB.concat++instance SB String where+    to_sb = SU.fromString++class LB a where+    to_lb :: a -> LB.ByteString++instance LB LB.ByteString where+    to_lb = P.id++instance LB SB.ByteString where+    to_lb = return > LB.fromChunks++instance LB String where+    to_lb = LU.fromString++class US a where+  to_us :: a -> String++instance  US String where+  to_us = P.id++instance US LB.ByteString where+  to_us = LU.toString++instance US SB.ByteString where+  to_us = SU.toString++lower = S.map toLower++isInfixOf = S.isInfixOf++read_bytestring = u2b > S.readFile
src/Bamboo/Helper/Env.hs view
@@ -22,7 +22,7 @@   , module Data.Foldable   , module Data.Default   , module Hack.Contrib.Utils-  , module Data.ByteString.Lazy.Char8 +  , module Data.ByteString.Char8    , module Bamboo.Helper.ByteString ) where @@ -44,5 +44,5 @@ import Data.Foldable (find) import Data.Default import Hack.Contrib.Utils (httpdate)-import Data.ByteString.Lazy.Char8 (pack, unpack)+import Data.ByteString.Char8 (pack, unpack) import Bamboo.Helper.ByteString hiding (lower, isInfixOf)
src/Bamboo/Helper/Helper.hs view
@@ -28,7 +28,7 @@ import Hack.Contrib.Response import Hack.Contrib.Constants import Hack.Contrib.Utils-import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S import Bamboo.Helper.ByteString  gt = (P.>)@@ -109,15 +109,20 @@ div_class_id x y = thediv ! [theclass x, id y]  xml_header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"-render_html = renderHtml > unescape_unicode_xml > u2bs+render_html = renderHtml > unescape_unicode_xml > to_sb output_html = render_html > output_plain_html+render_rss = (xml_header ++) > unescape_unicode_xml > to_sb  output_plain_html x =    def      .set_status 200-    .set_body x+    .set_body (x.to_lb)     .set_content_type _TextHtmlUTF8     .return++output_plain_rss = output_plain_html+  > (^ set_content_type "application/rss+xml")+        spaced_url = gsub "/" " / " @@ -185,5 +190,5 @@ class FlatRead a where   flat_read :: String -> IO a -instance Default L.ByteString where-  def = L.empty+instance Default S.ByteString where+  def = S.empty
src/Bamboo/Helper/StateHelper.hs view
@@ -7,7 +7,7 @@  import Bamboo.Helper.Env hiding (path) import qualified Bamboo.Config.Global as G-import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S  -- G.root = /blog -- raw_uri = blog/x@@ -38,9 +38,9 @@ -- controller paginate env xs = full_paginate (G.per_page) (xs.length) env -cut       = G.cut.u2bs-match_cut = L.lines > any (L.isPrefixOf cut)-is_cut    = L.isPrefixOf cut+cut       = G.cut.to_sb+match_cut = S.lines > any (S.isPrefixOf cut)+is_cut    = S.isPrefixOf cut  -- not used for efficiency -- cut_re    = "^\\s*" ++ cut
src/Bamboo/Model/Comment.hs view
@@ -9,12 +9,12 @@ import qualified Bamboo.Model.Post as Post import Bamboo.Helper.StateHelper import Network.Gravatar-import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S  data Comment = Comment   { uid    :: String     -- comment/08-09-04 blog title   , author :: String-  , body   :: L.ByteString+  , body   :: S.ByteString   , author_email :: String   , author_link    :: String   }@@ -87,7 +87,7 @@     let uid  = comment_path / timestamp     def        { uid = uid-      , body = at Body .u2bs+      , body = at Body .to_sb       , author = at Author       , author_email = at AuthorEmail       , author_link = at AuthorLink@@ -95,7 +95,7 @@       .return  write_to x = do-  L.writeFile (x.uid.u2b) (x.body)+  S.writeFile (x.uid.u2b) (x.body)   write_config_io (x.uid.meta) meta_data   where     meta_data =
src/Bamboo/Model/Post.hs view
@@ -17,14 +17,15 @@ 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 Data.ByteString.Char8 as S+import qualified Data.ByteString.Char8 as S 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 :: L.ByteString+  , body :: S.ByteString   , tags :: [String]   , comment_size :: Int   , reader :: Reader@@ -75,7 +76,7 @@   size <- path.file_size ^ show   return $ [id, mtime, size, x.comment_size.show, x.count.show] .join "," .pack -etag_post_list xs = xs.mapM etag_post ^ sort ^ L.intercalate (pack ",")+etag_post_list xs = xs.mapM etag_post ^ sort ^ S.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})@@ -88,15 +89,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 > u2bs, body] .map (send_to x > BS.lower > BS.isInfixOf (s.lower.u2bs)) .or+match s x = [title > to_sb, body] .map (send_to x > BS.lower > BS.isInfixOf (s.lower.to_sb)) .or search "" = return [] search s  = list ^ filter (match s) -summary x = x.body.L.lines.takeWhile (is_cut > not) .L.unlines+summary x = x.body.S.lines.takeWhile (is_cut > not) .S.unlines full x | x.body.match_cut.not = x.body-full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).L.unlines where+full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).S.unlines where   not_cut = is_cut > not-  xs = x.body.L.lines+  xs = x.body.S.lines  has_continue = body > match_cut
src/Bamboo/Model/Static.hs view
@@ -5,13 +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 qualified Data.ByteString.Char8 as S import Bamboo.Type.Cache import Bamboo.Helper.StateHelper  data Static = Static    { uid :: String-  , body :: L.ByteString+  , body :: S.ByteString   , reader :: Reader   }   deriving (Show, Eq)@@ -23,7 +23,7 @@   markup x = render_to_html (x.reader) (x.body)  instance Default Static where-  def = Static def L.empty def+  def = Static def S.empty def  -- CRUD instance FlatRead Static where
src/Bamboo/Model/Tag.hs view
@@ -10,13 +10,13 @@ import qualified Bamboo.Config.Global as G import Bamboo.Type.Cache import Data.List (sort)-import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S   data Tag = Tag    { uid :: String     -- tag/name   , name :: String-  , resources :: S.Set L.ByteString+  , resources :: S.Set S.ByteString   }   deriving (Show, Eq) @@ -30,20 +30,20 @@ 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 ",")+etag_tag_list xs = xs.mapM (uid > etag_data) ^ sort ^ S.intercalate (pack ",")  get_name id      = id.split "/" .tail.join' get_resources id = id.id_to_path.read_bytestring -get_resources_set id = id.cache etag_data get_resources ^ L.lines ^ map (bs_slash $ G.post_id.pack ) ^ to_set+get_resources_set id = id.cache etag_data get_resources ^ S.lines ^ map (bs_slash $ G.post_id.pack ) ^ to_set -bs_slash x y = L.concat [x, "/".pack, y.L.dropWhile (is '/')]+bs_slash x y = S.concat [x, "/".pack, y.S.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.u2bs)) .map name+for_resource xs x = xs.select (resources > has (x.to_sb)) .map name fill_tag xs x     = x { Post.tags = for_resource xs (x.Post.uid) }  -- extra
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+import qualified Data.ByteString.Char8 as S      cache_file = G.cache_uri -set k v = TC.runTCM $ putsample cache_file [(k.l2s, v.l2s)]+set k v = TC.runTCM $ putsample cache_file [(k, v)] get k = do-  v <- TC.runTCM $ getsample cache_file (k.l2s)-  return $ v ^ s2l+  v <- TC.runTCM $ getsample cache_file k+  return $ v  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 L.ByteString) -> (a -> IO L.ByteString) -> a -> (IO L.ByteString)+cache' :: (a -> IO S.ByteString) -> (a -> IO S.ByteString) -> a -> (IO S.ByteString) cache' g f x = do   k <- g x   c <- get k
src/Bamboo/Type/Plugin.hs view
@@ -7,7 +7,7 @@ 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+import qualified Data.ByteString.Char8 as S  data PluginType = PhotoAlbum | Video | None deriving (Show, Eq) @@ -31,7 +31,7 @@ infix_of = flip BS.isInfixOf  optimized_match x-  | pack "[[" .infix_of x = x.bs2u.match plugin_expression+  | pack "[[" .infix_of x = x.to_us.match plugin_expression   | otherwise = Nothing  @@ -48,7 +48,7 @@  match_result x = x.fromJust.snd.first.snd.b2u -apply_plugin :: L.ByteString -> IO L.ByteString+apply_plugin :: S.ByteString -> IO S.ByteString apply_plugin x = if r.isNothing then return x else sub_it where   r = x.optimized_match   plugin = r.match_result.parse_plugin@@ -56,9 +56,9 @@     None -> return x     PhotoAlbum -> do        album <- plugin.args.Album.from_list ^ render_plugin-      x.bs2u.sub plugin_expression album .u2bs.apply_plugin+      x.to_us.sub plugin_expression album .to_sb.apply_plugin     Video -> do        video <- plugin.args.V.from_list ^ render_plugin-      x.bs2u.sub plugin_expression video .u2bs.apply_plugin+      x.to_us.sub plugin_expression video .to_sb.apply_plugin  render_plugin x = "\n" ++ x.render_data.show
src/Bamboo/Type/Reader.hs view
@@ -8,7 +8,8 @@  import Text.XHtml.Strict import Data.Default-import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Char8 as S import Bamboo.Helper.ByteString  data Reader = Markdown | RST | HTML | Latex deriving (Show, Eq)@@ -33,10 +34,10 @@  -- this list can go on, as long as there is a library that does -- the convertion. pretty extensible, isn't it.-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+rr :: Reader -> S.ByteString -> Html+rr Markdown    = to_us > to_html readMarkdown+rr RST         = to_us > to_html readRST+rr HTML        = to_us > primHtml+rr Latex       = to_us > to_html readLaTeX  render_to_html = rr
src/Bamboo/Type/StaticWidget.hs view
@@ -3,11 +3,11 @@  import Bamboo.Helper.Env hiding (body) import Bamboo.Type.Reader-import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S  data StaticWidget = StaticWidget   { name :: String-  , body :: L.ByteString+  , body :: S.ByteString   , reader :: Reader   }   deriving (Show, Eq)
src/Bamboo/View/Widget/RSS.hs view
@@ -2,7 +2,7 @@ module Bamboo.View.Widget.RSS where  -- env-import Bamboo.Helper.Env -- hiding (Language)+import Bamboo.Helper.Env hiding (render_rss) import qualified Bamboo.Config.Global as G import Text.RSS import qualified Text.RSS as RSS