diff --git a/Panda/Config/Global.hs b/Panda/Config/Global.hs --- a/Panda/Config/Global.hs +++ b/Panda/Config/Global.hs @@ -5,7 +5,6 @@ import Prelude hiding ((.), (/), (^), id, readFile) import System.FilePath hiding ((<.>)) -import System.IO.UTF8 (readFile, writeFile) import Control.Arrow ((>>>), (&&&), (***)) import Data.Maybe import System.Directory @@ -37,8 +36,7 @@ -- unsafe, must restart server after changing config file, sorry about that ... -- but these configs are read only, and keep the view pure, so no monad headaches involved. -user_config' s = readFile s .purify .filter_comment .lines .map strip .map (split "\\s*=\\s*") .map tuple2 -user_config = user_config' config_uri +user_config = parse_config config_uri config_for' s d = user_config.lookup s .fromMaybe d config_for s = config_for' s s @@ -49,7 +47,7 @@ author_email = config_for "author_email" per_page = config_for' "per_page" "7" .read :: Int -navigation = config_for' "navigation" "About" .parse_config.("Home" :) +navigation = config_for' "navigation" "About" .parse_list.("Home" :) panda_url = "http://github.com/nfjinjing/panda" root @@ -59,7 +57,7 @@ default_reader = Markdown -sidebar = config_for "sidebar" .parse_config .map (sidebar_uri /).select (to_utf8 >>> doesFileExist >>> purify ) +sidebar = config_for "sidebar" .parse_list .map (sidebar_uri /).select (to_utf8 >>> doesFileExist >>> purify ) .map (read_sidebar_item default_reader >>> purify) favicon = config_for' "favicon" "/favicon.ico" @@ -74,7 +72,7 @@ user_theme_uri = (theme_uri / user_theme_name) ++ ".txt" theme = if user_theme_uri.doesFileExist.purify - then user_config' user_theme_uri .(("name", user_theme_name) : ) .to_theme + then parse_config user_theme_uri .(("name", user_theme_name) : ) .to_theme else default_theme -- custom @@ -85,4 +83,13 @@ url_date_matcher = config_for' "url_date_matcher" "\\d{2}-\\d{2}-\\d{2}" url_title_subs = config_for' "url_title_subs" "" .as_l .read :: [(String, String)] url_date_title_seperator = config_for' "url_date_title_seperator" " " + +-- summary +cut = config_for' "cut" "✂-----" .to_utf8 +parse_boolean = belongs_to ["true", "1", "y", "yes", "yeah"] +summary_for_root = config_for "summary_for_root" .parse_boolean +summary_for_tag = config_for "summary_for_tag" .parse_boolean +summary_for_rss = config_for "summary_for_rss" .parse_boolean + + diff --git a/Panda/Controller/Application.hs b/Panda/Controller/Application.hs --- a/Panda/Controller/Application.hs +++ b/Panda/Controller/Application.hs @@ -83,9 +83,11 @@ comments <- Comment.list_for id .u tags <- tag_list - let state = S.empty { S.uid = id, S.tags = tags, S.resource_title = blog.resource_title } + test_data <- S.mk_human_test .u + let state = S.empty { 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 + static = do id <- uri static_page <- Static.get id .u @@ -130,7 +132,7 @@ posts.mapM (init_post tags) >>= \x -> x.SearchV.view state s.output_html comment_create = do - post_id <- input_with_default "post_id" (G.post_id / "nothing") + post_id <- input_with_default (show_data Comment.PostId) (G.post_id / "nothing") exists <- (G.flat_uri / post_id.to_utf8) .doesFileExist .u let valid_path = equalFilePath G.post_id (takeDirectory post_id) checked <- check_create @@ -142,18 +144,29 @@ return () redirect $ (post_id.Post.id_to_uri.to_utf8).urlEncode +get_input_data = show_data >>> get_input +check_human = do + x <- [Comment.LeftNumber, Comment.RightNumber, Comment.Operator, Comment.HumanHack].mapM get_input_data ^ map fromJust + let [l, r, op, h] = x + 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 = - [ validate "author" ( length >>> (> 0)) - , validate "author_link" (const True) - , validate "comment" ( length >>> (> 0)) - , validate "human_hack" (is "10") + [ validate Comment.Author ( length >>> (> 0)) + , validate Comment.AuthorLink ( const True) + , validate Comment.Body ( length >>> (> 0)) + , validate Comment.EmptyField ( empty ) + , validate Comment.LeftNumber ( belongs_to (S.nums.map show)) + , validate Comment.RightNumber ( belongs_to (S.nums.map show)) + , validate Comment.Operator ( belongs_to (S.ops.map S.display_op)) + , validate Comment.HumanHack ( belongs_to (S.nums.map show)) + , check_human ] .sequence ^ and validate s f = do - maybe_s <- get_input s + maybe_s <- get_input_data s case maybe_s of Nothing -> return False Just v -> return $ f v diff --git a/Panda/Helper/Helper.hs b/Panda/Helper/Helper.hs --- a/Panda/Helper/Helper.hs +++ b/Panda/Helper/Helper.hs @@ -6,6 +6,7 @@ module Panda.Helper.Helper where +import System.IO.UTF8 (readFile, writeFile) import Network.URI import Network.CGI import System.FilePath.Posix (()) @@ -15,7 +16,7 @@ import Data.Maybe import Panda.Type.Pager as Pager hiding (empty) import MPS hiding (date) -import Prelude hiding ((.), (/), (^), id) +import Prelude hiding ((.), (/), (^), id, readFile, writeFile) import Char import Data.List import qualified Data.List as L @@ -23,12 +24,21 @@ import System.FilePath.Posix hiding ((<.>)) import System.Time + (/) = () infixl 5 / (^) = (<.>) infixl 9 ^ +-- global +parse_config_io s = readFile s ^ (\x -> x.filter_comment.lines.map strip .map (split "\\s*=\\s*") .map fill_snd_blank .map tuple2) + where fill_snd_blank [x] = [x,""] + fill_snd_blank xs = xs +parse_config = parse_config_io >>> purify + +write_config_io s xs = xs.map(\(x, y) -> x ++ " = " ++ y) .join "\n" .writeFile s + -- model take_extension = takeExtension >>> split "\\." >>> last @@ -89,17 +99,28 @@ spaced_url = gsub "/" " / " -- config -parse_config s = s.split "," .map strip .reject null +parse_list s = s.split "," .map strip .reject null not_found = getVar "REQUEST_URI" >>= (fromMaybe "" >>> outputNotFound) +-- generic + +starts_with _ [] = False +starts_with (x:xs) (y:ys) | x == y = starts_with xs ys + | otherwise = False + +ends_with x y = starts_with (x.reverse) (y.reverse) + +capitalize (x:xs) = [x].upper ++ xs.lower +camel_case = split "_" >>> map capitalize >>> join' +snake_case = gsub "\\B[A-Z]" "_\\&" >>> lower +show_data = show >>> snake_case + + -- class class DataRenderer a where render_data :: a -> Html -class FormRenderer a where - render_form :: a -> Html - class Resource a where resource_title :: a -> String @@ -111,3 +132,5 @@ class Addressable a where uri :: a -> String + + diff --git a/Panda/Helper/StateHelper.hs b/Panda/Helper/StateHelper.hs --- a/Panda/Helper/StateHelper.hs +++ b/Panda/Helper/StateHelper.hs @@ -35,3 +35,9 @@ -- controller paginate = length >>> full_paginate (G.per_page) + +cut = G.cut +cut_re = "^\\s*" ++ cut +match_cut = to_utf8 >>> match cut_re +is_cut = match_cut >>> isJust +split_cut = to_utf8 >>> split cut_re diff --git a/Panda/Model/Comment.hs b/Panda/Model/Comment.hs --- a/Panda/Model/Comment.hs +++ b/Panda/Model/Comment.hs @@ -1,13 +1,14 @@ module Panda.Model.Comment where -- env -import Panda.Helper.Env hiding (match, title, body) +import Panda.Helper.Env hiding (title, body, size) import Prelude hiding ((.), (/), (^), id, readFile, writeFile) import qualified Panda.Config.Global as G import Panda.Type.Reader import qualified Panda.Model.Post as Post import System.Directory import Panda.Helper.StateHelper +import Network.Gravatar data Comment = Comment { uid :: String -- comment/08-09-04 blog title @@ -18,6 +19,22 @@ } deriving (Show, Eq) +data CommentData = + Author + | AuthorEmail + | AuthorLink + | Body + | PostId + deriving (Show) + +data SpanFilter = + HumanHack + | EmptyField + | LeftNumber + | RightNumber + | Operator + deriving (Show) + instance Resource Comment where resource_title = uid >>> spaced_url @@ -27,40 +44,46 @@ instance Datable Comment where date x = x.uid.split "/".last.default_parse_date + -- CRUD list_for post_id = do has_comments <- doesDirectoryExist d if has_comments - then ls d ^ rsort ^ map (G.comment_id / r /) >>= mapM (from_utf8 >>> get) + then ls d ^ reject (match "\\.meta$" >>> isJust) ^ rsort ^ map (G.comment_id / r /) >>= mapM (from_utf8 >>> get) else return [] where d = (G.comment_uri / r) r = post_id.id_to_resource.to_utf8 + get id = do - xs <- (G.flat_uri / id.to_utf8) .readFile ^ lines - let author = xs.first - let author_email = "" - let author_link = xs.drop 2.first - let body = xs.drop 4.unlines + body <- path.readFile + meta <- (path ++ ".meta").parse_config_io + let at s = meta.lookup (s.show_data) .fromJust + let author = at Author + let author_email = at AuthorEmail + let author_link = at AuthorLink + return $ Comment id author body author_email author_link + where + path = G.flat_uri / id.to_utf8 +gravatar_default_size = size 40 +gravatar_link x = gravatarWith (x.author_email) Nothing gravatar_default_size Nothing + create h = do - let author = at "author" - let author_link = at "author_link" - -- let author_email = at "author_email" - let body = at "comment" - let post_id = at "post_id" + let at s = h.lookup (s.show_data) .fromJust + let body = at Body + let post_id = at PostId timestamp <- ( getClockTime >>= toCalendarTime ) ^ format_date G.comment_date_format let comment_path = post_id_to_uid post_id .to_utf8 createDirectoryIfMissing True comment_path let uid = comment_path / timestamp - let content = [author, author_link, body].join "\n\n" - writeFile uid content - - where at s = h.lookup s .fromJust + writeFile uid body + let meta = [Author, AuthorLink, AuthorEmail] .labeling at .map_fst show_data + write_config_io (uid ++ ".meta") meta -- extra from_post_id x = Comment (post_id_to_uid x) "" "" "" "" diff --git a/Panda/Model/Post.hs b/Panda/Model/Post.hs --- a/Panda/Model/Post.hs +++ b/Panda/Model/Post.hs @@ -10,7 +10,7 @@ import Prelude hiding ((.), (/), (^), id, readFile) import qualified Panda.Config.Global as G import Panda.Type.Reader -import Panda.Helper.StateHelper +import Panda.Helper.StateHelper hiding (uri) import Panda.Helper.Helper (date) data Post = Post @@ -27,12 +27,11 @@ resource_title = title instance Markable Post where - markup x = render_to_html (x.reader) (x.body) + markup x = render_to_html (x.reader) (x.full) instance Datable Post where date = uid >>> get_date - instance Addressable Post where uri = uid >>> id_to_uri @@ -50,6 +49,15 @@ search "" = return [] search s = list ^ filter (match s) +summary = body >>> split_cut >>> first >>> from_utf8 +full x | x.body.match_cut.isNothing = x.body +full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).unlines where + not_cut = is_cut >>> not + xs = x.body.lines + +has_continue = body >>> match_cut >>> isJust + + -- extra id_to_uri id = G.root / ( pretty_date ++ G.url_date_title_seperator ++ formatted_title ++ ext ) where formatted_title = G.url_title_subs.map (\(a,b) -> gsub a b).inject (id.get_title) apply @@ -62,3 +70,9 @@ t = G.url_title_subs.map (\(a,b) -> gsub b a) .inject raw_t apply d = raw_d.parse_date G.url_date_format .fromJust.format_date G.post_date_format + +-- summary +markup_summary x = post_summary x +++ next where + post_summary = (reader &&& summary) >>> splash render_to_html + next = if x.has_continue then toHtml $ hotlink (x.uri) << "Read the rest of the post »" else toHtml "" + diff --git a/Panda/Type/State.hs b/Panda/Type/State.hs --- a/Panda/Type/State.hs +++ b/Panda/Type/State.hs @@ -2,6 +2,11 @@ import qualified Panda.Type.Pager as Pager import Panda.Model.Tag +import Random (randomRs, mkStdGen) +import System.Time +import Control.Arrow ((>>>), (&&&), (***)) +import MPS +import Prelude hiding ((.), (/), (^), id, readFile, writeFile) data State = State -- model state @@ -12,7 +17,48 @@ , tags :: [Tag] , nav_location :: String , resource_title :: String + , human_test_data :: HumanTestData } deriving (Show) -empty = State "" Pager.empty [] "" "" +show_left = human_test_data >>> left >>> show +show_right = human_test_data >>> right >>> show +show_op = human_test_data >>> op >>> display_op where + +read_op "+" = Plus +read_op "-" = Minus +read_op x = error ("can not read operator: " ++ x) + +display_op Plus = "+" +display_op Minus = "-" + +data HumanTestData = HumanTestData + { left :: Int + , right :: Int + , op :: Op + } deriving (Show) + +data Op = Plus | Minus deriving (Show) + +empty = State "" Pager.empty [] "" "" empty_human_test +empty_human_test = HumanTestData 0 0 Plus + +(^) = (<.>) +infixl 9 ^ + +ops = [Plus, Minus] +nums = [0, 5, 10, 15, 20] +simple_eval a b Plus = a + b +simple_eval a b Minus = a - b + + +mk_human_test = do + seed <- (getClockTime >>= toCalendarTime) ^ ctPicosec ^ fromIntegral + let (a,b,c) = randomRs (0,100) (mkStdGen seed) .in_group_of 3 .map make_sample .dropWhile (good_test >>> not) .first + return $ HumanTestData a b c + + where + make_sample [a,b,c] = ((get_num a), (get_num b), (get_op c)) + good_test = splash3 simple_eval >>> belongs_to nums + get_num n = nums.at (n `mod` (nums.length)) + get_op n = ops.at (n `mod` (ops.length)) diff --git a/Panda/Type/Theme.hs b/Panda/Type/Theme.hs --- a/Panda/Type/Theme.hs +++ b/Panda/Type/Theme.hs @@ -28,8 +28,8 @@ } where at s = xs.lookup s .fromJust - css_list s = s.parse_config.map (\x -> "/theme/" ++ at "name" ++ "/css/" ++ x ++ ".css") - js_list s = s.parse_config.map (\x -> "/theme/" ++ at "name" ++ "/js/" ++ x ++ ".js") + css_list s = s.parse_list.map (\x -> "/theme/" ++ at "name" ++ "/css/" ++ x ++ ".css") + js_list s = s.parse_list.map (\x -> "/theme/" ++ at "name" ++ "/js/" ++ x ++ ".js") blank_theme = Theme { name = "" diff --git a/Panda/View/Atom/Comment.hs b/Panda/View/Atom/Comment.hs --- a/Panda/View/Atom/Comment.hs +++ b/Panda/View/Atom/Comment.hs @@ -4,6 +4,7 @@ import Prelude hiding ((.), (/), (^), id, span) import qualified Panda.Config.Global as G import Panda.Helper.StateHelper +import Panda.Type.State hiding (uid) -- view import qualified Panda.View.Atom.Tag as Tag @@ -16,37 +17,50 @@ render_data = entry entry x = toHtml - [ cite << a + [ gravatar + , cite << a , toHtml " says:" , br , p ! [theclass "small"] << comment_date x , x.markup ] - where a = if x.author_link.null then x.author.toHtml else toHtml $ hotlink (x.author_link) << x.author + where + a = if x.author_link.null then x.author.toHtml else toHtml $ hotlink (x.author_link) << x.author + gravatar = thediv ! [theclass "gravatar"] << image ! [src (gravatar_link x)] comment_date x = toHtml $ x.date.format_date "%b %e, %Y at %I:%M %p" -- form -instance FormRenderer Comment where - render_form = create +human_test_question state = ["What", "is", state.show_left, state.show_op, state.show_right, "?"] .join " " -create x = toHtml +create state x = toHtml [ h2 ! [id "respond"] << "Leave a Response" , gui (G.root / "comment/create") ! [id "commentform"] << - [ field "author" 22 1 "Name (required)" - -- , field "author_email" 22 2 "Email" - , field "author_link" 22 3 "Website" - , field "human_hack" 22 4 "What is 5 + 5 ?" - , p << hidden "post_id" (x.uid.uid_to_post_id) - , p << textarea ! [name "comment", id "comment", cols "10", rows "20", strAttr "tabindex" "5"] << "" + [ field Author 22 1 "Name (required)" + , field AuthorEmail 22 2 "Email (hidden)" + , field AuthorLink 22 3 "Website" + , field HumanHack 22 4 (human_test_question state) + , empty_field + , hidden_field LeftNumber (state.show_left) + , hidden_field RightNumber (state.show_right) + , hidden_field Operator (state.show_op) + , p << hidden (show_data PostId) (x.uid.uid_to_post_id) + , p << textarea ! [name (show_data Body), id "comment", cols "10", rows "20", strAttr "tabindex" "5"] << "" , p << submit "submit" "Submit Comment" ! [strAttr "tabindex" "6"] ] ] - -field x s t m = p << +field_with_value v x' s t m = p << [ label ! [thefor x] << small << m , br - , textfield x ! [size (s.show), strAttr "tabindex" (t.show)] + , textfield x ! [size (s.show), strAttr "tabindex" (t.show), value v] ] + where x = x'.show_data + +field x s t m = field_with_value "" x s t m + +hidden_field x m = hidden_field_with_value m x m +hidden_field_with_value v x m = thespan ! [ thestyle "display: none;" ] << field_with_value v x 22 10 m + +empty_field = hidden_field_with_value "" EmptyField "Leave this field empty:" diff --git a/Panda/View/Atom/Post.hs b/Panda/View/Atom/Post.hs --- a/Panda/View/Atom/Post.hs +++ b/Panda/View/Atom/Post.hs @@ -13,13 +13,21 @@ -- render instance DataRenderer Post where - render_data = entry + render_data = entry Full +data RenderStyle = Summary | Full + -- instance helpers -entry x = div_class "post" << [entry_title, entry_mark, entry_body] where +entry style x = div_class "post" << [entry_title, entry_mark, entry_body] where entry_title = x.title_link - entry_body = div_class "entry" << x.markup + entry_body = div_class "entry" << show_content style x entry_mark = p ! [theclass "small"] << [ post_date, post_tags, post_comments ].map (send_to x) + +show_content Summary x = x.markup_summary +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 title_link x = h2 << hotlink (x.uri) << x.title post_date x = toHtml $ x.date.format_date "%b %e, %Y" diff --git a/Panda/View/Control/Post.hs b/Panda/View/Control/Post.hs --- a/Panda/View/Control/Post.hs +++ b/Panda/View/Control/Post.hs @@ -18,8 +18,9 @@ import Panda.View.Widget.Template -- entry view -view state xs x = (x.render_data +++ CommentV.list xs +++ CommentV.create (x.uid.Comment.from_post_id) ).page state +view state xs x = (x.render_data +++ CommentV.list xs +++ CommentV.create state (x.uid.Comment.from_post_id) ).page state -- list view -list state = for_current_page p >>> map render_data >>> (+++ nav p G.root) >>> page state - where p = state.State.pager +list state = for_current_page p >>> map render >>> (+++ nav p G.root) >>> page state where + p = state.State.pager + render = render_summary G.summary_for_root diff --git a/Panda/View/Control/Tag.hs b/Panda/View/Control/Tag.hs --- a/Panda/View/Control/Tag.hs +++ b/Panda/View/Control/Tag.hs @@ -11,7 +11,8 @@ import Panda.View.Widget.Template -view state = for_current_page p >>> map render_data >>> (+++ nav p ( G.root / tag_id)) >>> page state - where p = state.State.pager - tag_id = state.State.uid +view state = for_current_page p >>> map render >>> (+++ 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 diff --git a/Panda/View/Widget/RSS.hs b/Panda/View/Widget/RSS.hs --- a/Panda/View/Widget/RSS.hs +++ b/Panda/View/Widget/RSS.hs @@ -14,9 +14,12 @@ -- RSS channel_rss_template = [ RSS.Language "en-us" ] +render_rss x | G.summary_for_rss.is True = x.markup_summary.show +render_rss x | otherwise = x.markup.show + item_rss_template x = [ Title $ x.Post.title - , Description $ x.markup.show + , Description $ x.render_rss , Author $ G.author_email , Link $ x.item_uri , PubDate $ x.date diff --git a/changelog.markdown b/changelog.markdown --- a/changelog.markdown +++ b/changelog.markdown @@ -1,3 +1,16 @@ +2008.10.24 +---------- + +### Feature + +* empty field for simple anti-spam +* gravatar support in comment +* dynamic simple math human test + +### Migrate + +* comment is in a new format not compatible with older version. I made a mistake in designing the comment file format, it's now in 2 files. One contains the comment body, the other contains the comment meta data. + 2008.10.21 ----------- diff --git a/panda.cabal b/panda.cabal --- a/panda.cabal +++ b/panda.cabal @@ -1,5 +1,5 @@ Name: panda -Version: 2008.10.21 +Version: 2008.10.24 Build-type: Simple Synopsis: A simple static blog engine Description: A simple static blog engine @@ -14,7 +14,7 @@ data-files: readme.markdown, changelog.markdown library - build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, mps >= 2008.10.15, parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, kibro == 0.3, utf8-string >= 0.3.1, pandoc >= 0.46, MissingH, parsec >= 2 + build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, mps >= 2008.10.15, parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, kibro == 0.3, utf8-string >= 0.3.1, pandoc >= 0.46, MissingH, parsec >= 2, gravatar >= 0.3 exposed-modules: Panda Panda.Config.Global diff --git a/readme.markdown b/readme.markdown --- a/readme.markdown +++ b/readme.markdown @@ -1,3 +1,3 @@ ## Panda: a simple blog engine in Haskell -[Panda homepage](http://jinjing.blog.easymic.com/static/panda/readme) +[Panda homepage](http://www.haskell.org/haskellwiki/Panda)