packages feed

panda 2008.10.21 → 2008.10.24

raw patch · 16 files changed

+239/−67 lines, 16 filesdep +gravatar

Dependencies added: gravatar

Files

Panda/Config/Global.hs view
@@ -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++
Panda/Controller/Application.hs view
@@ -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
Panda/Helper/Helper.hs view
@@ -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++
Panda/Helper/StateHelper.hs view
@@ -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
Panda/Model/Comment.hs view
@@ -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) "" "" "" ""
Panda/Model/Post.hs view
@@ -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 ""+
Panda/Type/State.hs view
@@ -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))
Panda/Type/Theme.hs view
@@ -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        = ""
Panda/View/Atom/Comment.hs view
@@ -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:"
Panda/View/Atom/Post.hs view
@@ -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"
Panda/View/Control/Post.hs view
@@ -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
Panda/View/Control/Tag.hs view
@@ -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
Panda/View/Widget/RSS.hs view
@@ -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
changelog.markdown view
@@ -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 -----------
panda.cabal view
@@ -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
readme.markdown view
@@ -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)