diff --git a/bamboo.cabal b/bamboo.cabal --- a/bamboo.cabal +++ b/bamboo.cabal @@ -1,5 +1,5 @@ Name: bamboo -Version: 2009.4.52 +Version: 2009.5.13 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, template, base64-string, zlib, directory, ansi-wl-pprint, filepath, containers, process, mps >= 2008.11.6, parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, kibro >= 0.4.2, utf8-string >= 0.3.3, pandoc, parsec >= 2, MissingH, gravatar >= 0.3, data-default >= 0.2, hcheat >= 2008.11.6, hack >= 2009.4.52, hack-contrib >= 2009.4.52 + 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 hs-source-dirs: src/ exposed-modules: Bamboo diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,15 @@ +2009.5.13 +--------- + +### Feature + +* Add comment support + +### Fix + +* Compatible with mps 5.13 +* remove unnecessary dependencies + 2009.4.52 --------- diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -1,4 +1,4 @@ -# Bamboo: a simple blog engine on Hack +# Bamboo: a simple blog middleware on hack Bamboo is a port of [Panda](http://github.com/nfjinjing/panda/tree), but runs on top of Hack. It's an experimental project but quite portable. @@ -92,7 +92,7 @@ import Hack.Contrib.Utils import Hack.Contrib.Middleware.ContentType - import Hack.Contrib.Middleware.ContentSize + import Hack.Contrib.Middleware.ContentLength import Hack.Contrib.Middleware.ShowExceptions import Hack.Contrib.Middleware.Static @@ -105,7 +105,7 @@ [ dummy_middleware -- completeness - , content_size + , content_length , content_type default_content_type -- debuging diff --git a/src/Bamboo/Controller/Application.hs b/src/Bamboo/Controller/Application.hs --- a/src/Bamboo/Controller/Application.hs +++ b/src/Bamboo/Controller/Application.hs @@ -20,6 +20,7 @@ import qualified Bamboo.Type.Pager as Pager import Bamboo.Type.Extension import Hack +import Hack.Contrib.Response (redirect) -- model import qualified Bamboo.Model.Post as Post @@ -51,7 +52,7 @@ , ("tag/.*/rss.xml$" ,tag_feed ) , ("tag/." ,tag ) , ("search" ,only_for Search $ search ) --- , ("comment/create" ,only_for Comment $ comment_create ) + , ("comment/create" ,only_for Comment $ comment_create ) ] .map_fst ((G.root /) > ("^" ++)) @@ -71,6 +72,7 @@ s <- default_state 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 index_feed _ = do @@ -134,28 +136,28 @@ posts.mapM (init_post tags) >>= \x -> x.SearchV.view state s.output_html -{- -comment_create = do - post_id <- input_with_default (show_data Comment.PostId) (G.post_id / "nothing") - exists <- (G.flat_uri / post_id) .file_exist .u + +comment_create env = do + let post_id = env.input_with_default (show_data Comment.PostId) (G.post_id / "nothing") + exists <- (G.flat_uri / post_id) .file_exist let valid_path = equalFilePath G.post_id (takeDirectory post_id) - checked <- check_create + let checked = check_create env if [checked, valid_path, exists].and - then - inputs >>= (Comment.create_comment > u) - else - return () - redirect $ (post_id.Post.id_to_uri.u2b).urlEncode + then + env.inputs.Comment.create_comment + else + return () + return $ def.redirect ((post_id.Post.id_to_uri.u2b).urlEncode) Nothing -get_input_data = show_data > get_input +get_input_data s env = env.get_input (s.show_data) check_human = do [l, r, op, h] <- [Comment.LeftNumber, Comment.RightNumber, Comment.Operator, Comment.HumanHack].mapM get_input_data ^ map fromJust return $ S.simple_eval (l.read) (r.read) (op.S.read_op) .is (h.read) -- create helper, should be refactored to some common aspect -check_create = +check_create env = [ validate Comment.Author ( length > (`gt` 0)) , validate Comment.AuthorLink ( const True) , validate Comment.Body ( length > (`gt` 0)) @@ -165,13 +167,11 @@ , validate Comment.Operator ( belongs_to (S.ops.map S.display_op)) , validate Comment.HumanHack ( belongs_to (S.nums.map show)) , check_human - ] .sequence ^ and + ] .map (send_to env) .and -validate s f = do - maybe_s <- get_input_data s +validate s f env = + let maybe_s = get_input_data s env in case maybe_s of - Nothing -> return False - Just v -> return $ f v - --} + Nothing -> False + Just v -> f v diff --git a/src/Bamboo/Helper/Env.hs b/src/Bamboo/Helper/Env.hs --- a/src/Bamboo/Helper/Env.hs +++ b/src/Bamboo/Helper/Env.hs @@ -28,7 +28,7 @@ import Control.Arrow ((>>>), (&&&), (***)) import Data.List (isSuffixOf, isInfixOf, isPrefixOf, sortBy, intersperse) import Network.URI -import Network.CGI hiding (Html) +import Network.CGI hiding (Html, redirect) import System.Locale import System.Time.Parse import Bamboo.Helper.Helper diff --git a/src/Bamboo/Helper/Helper.hs b/src/Bamboo/Helper/Helper.hs --- a/src/Bamboo/Helper/Helper.hs +++ b/src/Bamboo/Helper/Helper.hs @@ -8,7 +8,7 @@ module Bamboo.Helper.Helper where import Bamboo.Helper.PreludeEnv -import Network.CGI +import Network.CGI (urlDecode) import Text.XHtml.Strict hiding (p, meta, body) import qualified Text.XHtml.Strict as Html @@ -26,10 +26,6 @@ import qualified Hack.Contrib.Request as Request import Hack.Contrib.Response import Hack.Contrib.Constants - -(/) :: FilePath -> FilePath -> FilePath -(/) = () -infixl 5 / gt = (P.>) diff --git a/src/Bamboo/Helper/PreludeEnv.hs b/src/Bamboo/Helper/PreludeEnv.hs --- a/src/Bamboo/Helper/PreludeEnv.hs +++ b/src/Bamboo/Helper/PreludeEnv.hs @@ -3,16 +3,7 @@ module Bamboo.Helper.PreludeEnv ( module MPSUTF8 , module Prelude - , (>) - , strip ) where import Prelude hiding ((.), (/), (^), id, span, readFile, writeFile, div, (>)) -import MPSUTF8 hiding (base, col, date, strip, format_time) -import qualified MPSUTF8 as MPS -import Control.Arrow ((>>>)) - -(>) = (>>>) -infixl 8 > - -strip x = MPS.strip (x.u2b) .b2u +import MPSUTF8 hiding (base, date, format_time) diff --git a/src/Bamboo/View/Widget/Template.hs b/src/Bamboo/View/Widget/Template.hs --- a/src/Bamboo/View/Widget/Template.hs +++ b/src/Bamboo/View/Widget/Template.hs @@ -17,7 +17,7 @@ -- extension import Bamboo.Type.Extension import Bamboo.Helper.StateHelper -import HCheat +import Web.HCheat body t state x = Html.body << [ div_class (t.T.container) <<