packages feed

panda 2008.10.24 → 2008.10.25

raw patch · 76 files changed

+1441/−1391 lines, 76 filesdep ~kibro

Dependency ranges changed: kibro

Files

− Panda.hs 
@@ -1,10 +0,0 @@-module Panda-  (-    module Panda.Controller.Application,-    panda-  ) where--import Panda.Controller.Application-import Kibro--panda = startKibro pages
− Panda/Config/Global.hs 
@@ -1,95 +0,0 @@-module Panda.Config.Global where--import Panda.Helper.Helper-import MPS-import Prelude hiding ((.), (/), (^), id, readFile)--import System.FilePath hiding ((<.>))-import Control.Arrow ((>>>), (&&&), (***))-import Data.Maybe-import System.Directory--import Panda.Type.Reader-import Panda.Type.Sidebar-import Panda.Type.Theme--db_id       = "db"-flat_id     = "."-post_id     = "blog"-config_id   = "config"-tag_id      = "tag"-comment_id  = "comment"-sidebar_id  = "sidebar"-theme_id    = "theme"--db_uri      = db_id-flat_uri    = db_uri / flat_id--config_uri  = flat_uri / config_id / "site.txt"-sidebar_uri = flat_uri / config_id / sidebar_id-post_uri    = flat_uri / post_id-tag_uri     = flat_uri / tag_id-comment_uri = flat_uri / comment_id-theme_uri   = flat_uri / config_id / theme_id----- 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 = parse_config config_uri--config_for' s d = user_config.lookup s .fromMaybe d-config_for s    = config_for' s s--blog_title      = config_for "blog_title"-blog_subtitle   = config_for "blog_subtitle"-host_name       = config_for "host_name"-author_email    = config_for "author_email" --per_page        = config_for' "per_page" "7" .read :: Int-navigation      = config_for' "navigation" "About" .parse_list.("Home" :)--panda_url       = "http://github.com/nfjinjing/panda"-root            -  | user_root.belongs_to ["/", ""]  = "/"-  | otherwise                       =  user_root.("/" /).remove_trailing_slash-  where user_root = config_for' "root" "/"--default_reader  = Markdown--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"----- extensions-analytics_account_id = config_for "analytics_account_id"---- theme-default_theme = blank_theme-user_theme_name = config_for "theme"-user_theme_uri = (theme_uri / user_theme_name) ++ ".txt"--theme = if user_theme_uri.doesFileExist.purify-  then parse_config user_theme_uri .(("name", user_theme_name) : ) .to_theme-  else default_theme-  --- custom-as_l s                   = "[" ++ s ++ "]"-post_date_format         = config_for' "post_date_format" "%y-%m-%d"-comment_date_format      = config_for' "comment_date_format" "%y-%m-%d %T"-url_date_format          = config_for' "url_date_format" "%y-%m-%d"-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 
@@ -1,172 +0,0 @@--- the controller is the most complex module for a reason:--- models are made as simple and small as possible--- views are pure functions.---- a note on encoding:--- IOs are in utf-8 filter, internally use bytes--{-# OPTIONS -fno-monomorphism-restriction #-}--module Panda.Controller.Application where--import qualified Data.Map as Map---- env-import Panda.Helper.Env hiding (tag, uri)-import Panda.Helper.StateHelper-import Prelude hiding ((.), (/), (^), id)-import qualified Panda.Type.State as S-import qualified Panda.Config.Global as G-import qualified Panda.Type.Pager as Pager---- model-import qualified Panda.Model.Post as Post-import qualified Panda.Model.Static as Static-import qualified Panda.Model.Tag as Tag-import qualified Panda.Model.Comment as Comment---- view-import qualified Panda.View.Control.Post as PostV-import qualified Panda.View.Widget.Template as T-import qualified Panda.View.Control.Static as StaticV-import qualified Panda.View.Control.Tag as TagV-import qualified Panda.View.Control.Search as SearchV-import qualified Panda.View.Widget.RSS as RSSV---- helpers--- liftIO: move to an (u)pper level monad-u = liftIO-blog_regex = G.url_date_matcher--init_post tags x = do-  x.Tag.fill_tag tags.Comment.fill_comment_size.u--tag_list = Tag.list.u----- main controller--pages = -  [ ("$"                  ,index              )-  , ("(\\?.+)?$"          ,index              )-  , ("rss.xml$"           ,index_feed         )-  , (blog_regex           ,blog               )-  , ("static/."           ,static             )-  , ("tag/.*/rss.xml$"    ,tag_feed           )-  , ("tag/."              ,tag                )-  , ("search"             ,search             )-  , ("comment/create"     ,comment_create     )-  ] .map_fst ((G.root /) >>> ("^" ++))-  ++-  [ ("^" ++ G.root ++ "$" ,index              )-  , ("^" ++ G.root ++ "?" ,index              )-  ]-  ---index = do-  posts <- Post.list.u-  p <- paginate posts-  tags <- tag_list-  let nav = if p.Pager.current == 1 then home_nav else no_navigation-  let state = S.empty { S.uid = G.post_id, S.pager = p, S.tags = tags, S.nav_location = nav }-  -  posts.mapM (init_post tags) ^ PostV.list state >>= output_html--index_feed = do-  posts <- Post.list.u-  posts.RSSV.rss "" "" .output--blog = do-  id <- uri ^ Post.uri_to_id-  blog <- Post.get id .u-  comments <- Comment.list_for id .u-  tags <- tag_list-  -  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-  tags <- tag_list-  -  let nav_id = static_page.Static.uid.id_to_resource-  let nav   = if nav_id.belongs_to G.navigation then nav_id else no_navigation-  let state = S.empty { S.uid = id, S.tags = tags, S.nav_location = nav, S.resource_title = static_page.resource_title }-  StaticV.view state static_page .output_html--tag = do-  id <- uri-  tags <- tag_list-  let tag_name = Tag.get_name id-  case Tag.tag_map' tags .Map.lookup tag_name of-    Nothing -> not_found-    Just post_set -> do-      posts <- post_set.to_list.rsort.mapM (Post.get) .u >>= mapM (init_post tags)-      p <- paginate posts-      let state = S.empty { S.uid = id, S.pager = p, S.tags = tags, S.resource_title = tag_name.Tag.resource_title_from_name }-      posts.TagV.view state.output_html--tag_feed = do-  id <- uri ^ (split "/" >>> init >>> join "/")-  tags <- tag_list-  let tag_name = Tag.get_name id-  case Tag.tag_map' tags .Map.lookup tag_name of-    Nothing -> not_found-    Just post_set -> do-      posts <- post_set.to_list.rsort.mapM (Post.get) .u ^ map (Tag.fill_tag tags)-      posts.RSSV.rss G.tag_id tag_name.output--search = do-  s <- param_with_default "s" ""-  posts <- Post.search s .u--  p <- paginate posts-  tags <- tag_list-  query <- uri-  let state = S.empty { S.uid = query, S.pager = p, S.tags = tags, S.resource_title = query }--  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.to_utf8) .doesFileExist .u-  let valid_path = equalFilePath G.post_id (takeDirectory post_id)-  checked <- check_create-  -  if [checked, valid_path, exists].and-    then-      inputs >>= (Comment.create >>> u)-    else-      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 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_data s-  case maybe_s of-    Nothing -> return False-    Just v -> return $ f v
− Panda/Extension/Analytics/T.hs 
@@ -1,19 +0,0 @@-module Panda.Extension.Analytics.T where--import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G--analytics_snippet = -  [ "<script type=\"text/javascript\">                                                                                                  "-  , "var gaJsHost = ((\"https:\" == document.location.protocol) ? \"https://ssl.\" : \"http://www.\");                                  "-  , "document.write(unescape(\"%3Cscript src='\" + gaJsHost + \"google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E\")); "-  , "</script>                                                                                                                          "-  , "<script type=\"text/javascript\">                                                                                                  "-  , "var pageTracker = _gat._getTracker(\"UA-xxxxxx-x\");                                                                               "-  , "pageTracker._trackPageview();                                                                                                      "-  , "</script>                                                                                                                          "-  ]-  .map strip-  .join "\n"-  .gsub "UA-xxxxxx-x" G.analytics_account_id
− Panda/Helper/Env.hs 
@@ -1,38 +0,0 @@--- this sets some scoping for every module, which prevents importing--- common modules in every file--module Panda.Helper.Env  (-    module MPS                 -  , module Control.Monad       -  , module Control.Arrow       -  , module Data.List           -  , module Network.URI         -  , module Network.CGI          -  , module System.Locale       -  , module System.Time.Parse-  , module Panda.Helper.Helper-  , module Data.Maybe-  , module System.FilePath-  , module System.IO.UTF8-  , module Text.XHtml.Strict-  , module System.Time-  , module System.Directory-  , module Data.Foldable-) where-  -import MPS hiding (base, col, sub, date)-import Control.Monad hiding (join)-import Control.Arrow ((>>>), (&&&), (***))-import Data.List hiding (find)-import Network.URI-import Network.CGI hiding (Html)-import System.Locale-import System.Time.Parse-import Panda.Helper.Helper-import Data.Maybe-import System.FilePath hiding ((<.>))-import System.IO.UTF8 (readFile, writeFile)-import Text.XHtml.Strict hiding (select)-import System.Time-import System.Directory-import Data.Foldable (find)
− Panda/Helper/Helper.hs 
@@ -1,136 +0,0 @@--- helper module is a central place for reusable functions--- for this project, more general helpers are usually moved--- to MPS package, for multi-project usage--{-# OPTIONS -fno-monomorphism-restriction #-}--module Panda.Helper.Helper where--import System.IO.UTF8 (readFile, writeFile)-import Network.URI-import Network.CGI-import System.FilePath.Posix ((</>))-import Control.Arrow ((>>>), (&&&))-import Text.XHtml.Strict-import Control.Monad hiding (join)-import Data.Maybe-import Panda.Type.Pager as Pager hiding (empty)-import MPS hiding (date)-import Prelude hiding ((.), (/), (^), id, readFile, writeFile)-import Char-import Data.List-import qualified Data.List as L -import Panda.Type.Reader-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---- controller-raw_uri = requestURI ^ (uriPath >>> urlDecode >>> tail >>> remove_trailing_slash >>> from_utf8 )-remove_trailing_slash s = if s.last.is '/' then s.init else s-  -params = do-  query_string <- requestURI ^ uriQuery -  case query_string of-    '?':s -> s.formDecode .map_snd unescape_unicode_xml.return-    otherwise -> return []--inputs = getInputs ^ map_snd (strip >>> unescape_unicode_xml)--param_with_default s d = params ^ (lookup s >>> fromMaybe d )-input_with_default s d = inputs ^ (lookup s >>> fromMaybe d )--get_param s = params ^ lookup s-get_input s = inputs ^ lookup s--just_param s = get_param s ^ fromJust-just_input s = get_input s ^ fromJust--full_paginate length total = liftM5 ( Pager length ) current has_next has_previous next previous where-  current      = param_with_default "page" "1" ^ read-  has_next     = current ^ ( (* length) >>> (< total.fromIntegral) )-  has_previous = current ^ (> 1)-  next         = current ^ (+ 1)-  previous     = current ^ (+ (-1) )---for_current_page p xs = xs.drop ((p.Pager.current - 1) * p.Pager.length) .take (p.Pager.length)---- id: /type/resoruce-id_to_type id     = id.split "/" .first-id_to_resource id = id.split "/" .tail.join "/"-no_navigation     = ""-home_nav          = "Home"----- view-id               = identifier--css_link l       = itag "link" ! [rel "stylesheet", thetype "text/css", href l]-js_link l        = itag "script" ! [thetype "text/javascript", src l]-js_src s         = tag "script" ! [thetype "text/javascript"] << s-rss_link l       = itag "link" ! [rel "alternate", thetype "application/rss+xml", href l, title "RSS 2.0"]-favicon_link l   = itag "link" ! [rel "icon", thetype "image/png", href l]-meta_tag         = meta ! [httpequiv "Content-Type", content "text/html; charset=utf-8"]--div_id s         = thediv ! [id s]-div_class s      = thediv ! [theclass s]-div_class_id x y = thediv ! [theclass x, id y]--output_html      = output ... renderHtml--spaced_url = gsub "/" " / "---- config-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 Resource a where-    resource_title :: a -> String--class Markable a where-    markup :: a -> Html-    -class Datable a where-    date :: a -> CalendarTime--class Addressable a where-    uri :: a -> String--
− Panda/Helper/StateHelper.hs 
@@ -1,43 +0,0 @@--- trying to merge this helper with the generic one results in cyclic imports--{-# OPTIONS -fno-monomorphism-restriction #-}--module Panda.Helper.StateHelper where--import Panda.Helper.Env-import qualified Panda.Config.Global as G-import Prelude hiding ((.), (/), (^), id)----- G.root = /blog--- raw_uri = blog/x--- full_uri = /blog/x--- uri = full_uri - (/blog/)-remove_root s-  | G.root.is "/" = s-  | otherwise     = s.slice (G.root.length) (s.length)--uri = raw_uri ^ remove_root--- uri = raw_uri----- global-parse_date format s = case maybe_d of-  Nothing -> Nothing-  Just d -> Just $ if d.ctYear < 1910 then d {ctYear = d.ctYear + 100} else d -  where-    maybe_d = parseCalendarTime defaultTimeLocale format s-  -format_date          = formatCalendarTime defaultTimeLocale-default_date         = parse_date "%Y-%m-%d %T" "2000-1-1 00:00:00".fromJust-parse_post_date      = parse_date G.post_date_format-default_parse_date s = s.parse_post_date .fromMaybe default_date---- 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 
@@ -1,96 +0,0 @@-module Panda.Model.Comment where---- env-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-  , author :: String-  , body   :: String-  , author_email :: String-  , author_link    :: String-  }-  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-  -instance Markable Comment where-  markup x  = render_to_html Markdown (x.body)--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 ^ 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-  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 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-  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) "" "" "" ""--post_id_to_uid x = G.flat_uri / G.comment_id / x.split "/" .last-uid_to_post_id x = G.post_id / x.split "/" .last--fill_comment_size x = do-  size <- x.Post.uid.list_for ^ length -  return $ x { Post.comment_size = size }
− Panda/Model/Post.hs 
@@ -1,78 +0,0 @@--- what about the performance?--- Haskell takes care of that, since IOs are also lazy.--- Posts are not read unless specifically required, i.e. after pagination--module Panda.Model.Post where---- env-import Panda.Helper.Env hiding (match, title, body, date)-import qualified MPS as MPS-import Prelude hiding ((.), (/), (^), id, readFile)-import qualified Panda.Config.Global as G-import Panda.Type.Reader-import Panda.Helper.StateHelper hiding (uri)-import Panda.Helper.Helper (date)--data Post = Post -  { uid :: String     -- blog/08-09-04 blog title-  , title :: String-  , body :: String-  , tags :: [String]-  , comment_size :: Int-  , reader :: Reader-  }-  deriving (Show, Eq)--instance Resource Post where-  resource_title = title--instance Markable Post where-  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---- CRUD-list = ls G.post_uri ^ map from_utf8 ^ rsort ^ map (G.post_id /) >>= mapM get--get id        = liftM4 (Post id (get_title id) ) (get_body id) (return []) (return 0) (return $ get_reader id)-get_extension = takeExtension-get_title id  = id.words.tail.unwords.dropExtension-get_body id   = (G.flat_uri / id.to_utf8) .readFile-get_reader id = id.take_extension.guess_reader.fromMaybe G.default_reader-get_date id   = id.words.first.split "/".last.default_parse_date--match s x = [title, body] .map (send_to x >>> lower >>> isInfixOf (s.lower)) .or-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-  pretty_date     = id.get_date.format_date G.url_date_format-  ext = id.get_extension--uri_to_id s = G.post_id / (d ++ " " ++ t) where-  (raw_d, (prefix, title_with_sep)) = s.MPS.match G.url_date_matcher.fromJust.fst-  raw_t = title_with_sep.drop (G.url_date_title_seperator.length)-  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/Model/Static.hs 
@@ -1,28 +0,0 @@-module Panda.Model.Static where---- env-import Panda.Helper.Env hiding (match, body)-import Prelude hiding ((.), (/), (^), id, readFile)-import qualified Panda.Config.Global as G-import Panda.Type.Reader--data Static = Static -  { uid :: String-  , body :: String-  , reader :: Reader-  }-  deriving (Show, Eq)--instance Resource Static where-  resource_title = uid >>> spaced_url--instance Markable Static where-  markup x = render_to_html (x.reader) (x.body)-  --- CRUD-get id        = liftM2 (Static id) (get_body id) (return $ get_reader id)-get_title     = id_to_resource >>> dropExtension-get_body id   = (G.flat_uri / id.to_utf8) .readFile-get_reader id = id.take_extension.guess_reader.fromMaybe G.default_reader--title = uid >>> get_title
− Panda/Model/Tag.hs 
@@ -1,39 +0,0 @@-module Panda.Model.Tag where--import qualified Panda.Model.Post as Post---- env-import Panda.Helper.Env hiding (name)-import Prelude hiding ((.), (/), (^), id, readFile)-import qualified Data.Set as S-import qualified Panda.Config.Global as G---data Tag = Tag -  { uid :: String     -- tag/name-  , name :: String-  , resources :: S.Set String-  }-  deriving (Show, Eq)--instance Resource Tag where-  resource_title = uid >>> spaced_url---- CRUD-list             = ls G.tag_uri ^ map from_utf8 ^ map (G.tag_id /) >>= mapM get--get id           = get_resources id ^ Tag id (get_name id)-get_name id      = id.split "/" .tail.join'-get_resources id = (G.flat_uri / id.to_utf8) .readFile-  ^ filter_comment ^ lines ^ map (G.post_id / ) ^ to_set--resource_title_from_name = name_to_id >>> 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) .map name-fill_tag xs x     = x { Post.tags = for_resource xs (x.Post.uid) }---- extra-sorted xs    = xs.sortBy(compare_by (resources >>> S.size)).reverse-name_to_id x = G.tag_id / x
− Panda/Type/Pager.hs 
@@ -1,13 +0,0 @@-module Panda.Type.Pager where-  -data Pager = Pager {-  length :: Int,-  current :: Int,-  has_next :: Bool,-  has_previous :: Bool,-  next :: Int,-  previous :: Int-  }-  deriving (Eq, Show)-  -empty = Pager 0 0 False False 0 0
− Panda/Type/Reader.hs 
@@ -1,37 +0,0 @@-{-# OPTIONS -XDeriveDataTypeable #-}--module Panda.Type.Reader where--import MPS  -import Prelude hiding ((.), (/), (^), id)-import qualified Data.Map as Map-import Text.Pandoc-import Control.Arrow ((>>>))-import Text.XHtml.Strict-import Data.Generics--data Reader = Markdown | RST | HTML | Latex deriving (Show, Eq, Typeable, Data)--readers = -  [ (Markdown,  ["markdown", "md"])-  , (RST,       ["rst"]  )-  , (HTML,      ["html", "htm"])-  , (Latex,     ["tex", "latex"])-  ]--gen_lookup (r, xs) = xs.labeling (const r)-reader_map         = readers.map gen_lookup.join'.to_h-guess_reader ext   = reader_map.Map.lookup ext---to_html r      = r defaultParserState >>> writeHtml defaultWriterOptions---- this list can go on, as long as there is a library that does--- the convertion. pretty extensible, isn't it.-rr Markdown    = to_html readMarkdown-rr RST         = to_html readRST-rr HTML        = primHtml-rr Latex       = to_html readLaTeX--render_to_html = rr-
− Panda/Type/Sidebar.hs 
@@ -1,20 +0,0 @@-module Panda.Type.Sidebar where--import Panda.Helper.Env hiding (body)-import Prelude hiding ((.), (/), (^), id, readFile)-import Panda.Type.Reader--data SidebarItem = SidebarItem-  { name :: String-  , body :: String-  , reader :: Reader-  }-  deriving (Show, Eq)--instance Markable SidebarItem where-  markup x  = render_to_html (x.reader) (x.body)--read_sidebar_item default_reader s = liftM2 (SidebarItem name) body (return reader) where-  body = s.to_utf8.readFile-  reader = s.take_extension.guess_reader.fromMaybe default_reader-  name = s.takeFileName.dropExtension
− Panda/Type/State.hs 
@@ -1,64 +0,0 @@-module Panda.Type.State where--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-  { uid     :: String       -- current view resource-  , pager   :: Pager.Pager        -- pager--  -- theme state-  , tags    :: [Tag]-  , nav_location :: String-  , resource_title :: String-  , human_test_data :: HumanTestData-  }-  deriving (Show)--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 
@@ -1,44 +0,0 @@-module Panda.Type.Theme where--import Prelude hiding ((.))-import Panda.Helper.Env hiding (name, header)--data Theme = Theme-  { name        :: String-  , container   :: String-  , header      :: String-  , navigation  :: String-  , main        :: String-  , sidebar     :: String-  , footer      :: String-  , css         :: [String]-  , js          :: [String]-  } deriving (Show, Read)-  -to_theme xs = Theme -  { name        = at "name"-  , container   = at "container"-  , header      = at "header"-  , navigation  = at "navigation"-  , main        = at "main"-  , sidebar     = at "sidebar"-  , footer      = at "footer"-  , css         = at "css" .css_list-  , js          = at "js"  .js_list-  }-  where-    at s = xs.lookup s .fromJust-    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        = ""-  , container   = ""-  , header      = ""-  , navigation  = ""-  , main        = ""-  , sidebar     = ""-  , footer      = ""-  , css         = [""]-  , js          = [""]-  }
− Panda/View/Atom/Comment.hs 
@@ -1,66 +0,0 @@-module Panda.View.Atom.Comment where-  -import Panda.Helper.Env hiding (title)-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---- model-import Panda.Model.Comment hiding (create)---- render-instance DataRenderer Comment where-  render_data = entry-  -entry x = toHtml  -  [ 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-    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-human_test_question state = ["What", "is", state.show_left, state.show_op, state.show_right, "?"] .join " "--create state x = toHtml-  [ h2 ! [id "respond"] << "Leave a Response"-  , gui (G.root / "comment/create") ! [id "commentform"] <<-    [ 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_with_value v x' s t m = p <<-  [ label ! [thefor x] << small << m-  , br -  , 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 
@@ -1,39 +0,0 @@-module Panda.View.Atom.Post where-  -import Panda.Helper.Env hiding (name, title)-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G-import Panda.Helper.StateHelper hiding (uri)---- view-import qualified Panda.View.Atom.Tag as Tag---- model-import Panda.Model.Post---- render-instance DataRenderer Post where-  render_data = entry Full--data RenderStyle = Summary | Full---- instance helpers-entry style x = div_class "post" << [entry_title, entry_mark, entry_body] where-  entry_title = x.title_link-  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"--post_tags x | x.tags.null = toHtml ""-post_tags x = " | " +++ "Published in " +++ x.tags.map Tag.tag_link .intersperse (", ".toHtml)--post_comments x | x.comment_size.is 0 = toHtml ""-post_comments x = " | " +++ hotlink ( x.uri / "#comments") << (x.comment_size.show ++ " Comments")
− Panda/View/Atom/Static.hs 
@@ -1,7 +0,0 @@-module Panda.View.Atom.Static where-  -import Panda.Helper.Env-import Panda.Model.Static--instance DataRenderer Static where-  render_data = markup
− Panda/View/Atom/Tag.hs 
@@ -1,12 +0,0 @@-module Panda.View.Atom.Tag where-  -import Panda.Helper.Env hiding (name)-import Panda.Model.Tag-import qualified Panda.Config.Global as G-import Prelude hiding ((/))--instance DataRenderer Tag where-  render_data = name >>> tag_link--tag_link s = toHtml $ hotlink (G.root / G.tag_id / s ) << s -
− Panda/View/Control/Comment.hs 
@@ -1,25 +0,0 @@-module Panda.View.Control.Comment where-  -import Panda.Helper.Env hiding (body, date)-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Type.State as State--import Panda.Model.Comment hiding (create)-import qualified Panda.Model.Post as Post---- view-import Panda.View.Control.Helper-import Panda.View.Widget.Template-import Panda.View.Atom.Comment as Comment----- api-styled_entry alt x = li ! [theclass alt] << x.render_data--list [] = []-list xs = -  [ h2 ! [id "comments"] << "Responses"-  , olist ! [theclass "commentlist" ] << xs.zip (cycle ["comments-alt", ""]).map (splash styled_entry)-  ]-  -create = Comment.create
− Panda/View/Control/Helper.hs 
@@ -1,26 +0,0 @@-module Panda.View.Control.Helper where--import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-  -import Panda.Type.Pager as Pager-import qualified Panda.Config.Global as G---nav p r = -  [ div_class "alignleft" << nav_previous p r-  , div_class "alignright" << nav_next p r-  ]-  -nav_previous p r = if p.Pager.has_previous -  then toHtml $ hotlink ( r' ++ "page=" ++ p.Pager.previous.show ) << previous_sign-  else spaceHtml-  where r' = if isSuffixOf "&" r then r else r ++ "?"-    -nav_next p r = if p.Pager.has_next-  then toHtml $ hotlink ( r' ++ "page=" ++ p.Pager.next.show ) << next_sign-  else spaceHtml-  where r' = if isSuffixOf "&" r then r else r ++ "?"--next_sign     = "Next Entries »"-previous_sign = "« Previous Entries"
− Panda/View/Control/Post.hs 
@@ -1,26 +0,0 @@-module Panda.View.Control.Post where---- env-import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)--import qualified Panda.Type.State as State-import qualified Panda.Config.Global as G---- model-import qualified Panda.Model.Comment as Comment-import Panda.View.Atom.Post-import Panda.Model.Post---- view-import Panda.View.Control.Helper-import qualified Panda.View.Control.Comment as CommentV-import Panda.View.Widget.Template---- entry view-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 >>> (+++ nav p G.root) >>> page state where -  p = state.State.pager-  render = render_summary G.summary_for_root
− Panda/View/Control/Search.hs 
@@ -1,15 +0,0 @@-module Panda.View.Control.Search where-  -import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Type.State as State-import qualified Panda.Config.Global as G---- view-import Panda.View.Atom.Post-import Panda.View.Control.Helper-import Panda.View.Widget.Template--view state s = for_current_page p >>> map render_data >>> (+++ nav p ( (G.root / "search") ++ "?s=" ++ s ++ "&")) >>> page state-  where p = state.State.pager-
− Panda/View/Control/Static.hs 
@@ -1,7 +0,0 @@-module Panda.View.Control.Static where-  -import Panda.Helper.Env-import Panda.View.Atom.Static-import Panda.View.Widget.Template--view state = render_data >>> page state
− Panda/View/Control/Tag.hs 
@@ -1,18 +0,0 @@-module Panda.View.Control.Tag where-  -import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Type.State as State-import qualified Panda.Config.Global as G---- view-import Panda.View.Atom.Post-import Panda.View.Control.Helper-import Panda.View.Widget.Template---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/Body.hs 
@@ -1,8 +0,0 @@-module Panda.View.Widget.Body where---- env-import Panda.Helper.Env--body_content x = div_id "maincontent" <<-  div_class "content" << x-
− Panda/View/Widget/Footer.hs 
@@ -1,17 +0,0 @@-module Panda.View.Widget.Footer where-  -import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G---footer c = div_class_id c "footer" <<-  [ toHtml $ copyright-  , toHtml $ "2008 "-  , toHtml $ G.blog_title-  , toHtml $ br-  , toHtml $ "Powered by "-  , toHtml $ hotlink G.panda_url << "Panda"-  , toHtml $ " using "-  , toHtml $ hotlink "http://www.haskell.org/" << "Haskell"-  ]
− Panda/View/Widget/Head.hs 
@@ -1,17 +0,0 @@-module Panda.View.Widget.Head where--import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G-import Panda.Type.Theme hiding (header)-import qualified Panda.Type.State as S-import Panda.View.Widget.Helper--html_head state = header << ([meta_tag, title_tag state, favicon_tag, rss_tag state] ++ G.theme.css.map css_link ++ G.theme.js.map js_link )--title_tag state = thetitle << [G.blog_title ++ state.S.resource_title.format_title]-rss_tag state   = rss_link $ rss_url_link_pair state .fst-favicon_tag = favicon_link G.favicon--format_title [] = ""-format_title s = " / " ++ s
− Panda/View/Widget/Header.hs 
@@ -1,18 +0,0 @@-module Panda.View.Widget.Header where-  -import Panda.Helper.Env hiding (header)-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G-import Panda.View.Widget.SearchBar--header c state =-  div_class_id c "header" << -    [ search_bar-    , site_name-    ]--site_name = toHtml $-  [ toHtml $ hotlink G.root ! [theclass "logo"] << ""-  , h1 << G.blog_title-  , div_class "description" << G.blog_subtitle-  ]
− Panda/View/Widget/Helper.hs 
@@ -1,20 +0,0 @@-module Panda.View.Widget.Helper where--import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-  -import qualified Panda.Config.Global as G-import qualified Panda.Type.State as State-import qualified Panda.Model.Tag as Tag--rss_url_link_pair state = -  if tagged -  then-    let tag_name = Tag.get_name uid in-      link ( G.tag_id / tag_name) tag_name-  else link "" "Home"-  where-    uid = State.uid state-    tagged = uid.match "^tag/.+" .isJust-    url r = G.root / r / "rss.xml"-    link r s = (url r, hotlink (url r) ! [ theclass "feedlink" ] << s)
− Panda/View/Widget/Navigation.hs 
@@ -1,19 +0,0 @@-module Panda.View.Widget.Navigation where-  -import Panda.Helper.Env hiding (header)-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G-import qualified Panda.Type.State as State--navigation c state = -  div_class_id c "nav" <<-    div_class "content" <<-      ulist << G.navigation.map (nav_item (state.State.nav_location))--nav_item nav s = li ! [theclass (home_tag ++ "page_item" ++ current)] << link s where-  home_tag = if s == home_nav then "first " else ""-  current = if s == nav then " current_page_item" else ""-  link x = if x == home_nav then home_link else static_link x--home_link     = hotlink G.root << home_nav-static_link s = hotlink (G.root / "static" / s) << s.dropExtension
− Panda/View/Widget/RSS.hs 
@@ -1,37 +0,0 @@-module Panda.View.Widget.RSS where---- env-import Panda.Helper.Env -- hiding (Language)-import Prelude hiding ((.), (/), (^), id)-import qualified Panda.Config.Global as G-import qualified Panda.Type.Pager as Pager-import Text.RSS-import qualified Text.RSS as RSS---- model-import Panda.Model.Post as Post---- 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.render_rss-  , Author $ G.author_email-  , Link $ x.item_uri-  , PubDate $ x.date-  ]--item_uri x = nullURI { uriScheme = "http://", uriPath = host_link (x.uri) }-rss_uri x  = nullURI { 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)-  .rssToXML.showXML-  where-    link = categary / s-    title = if s.empty then G.blog_title else G.blog_title ++ " / " ++ s--host_link s = G.host_name ++ (G.root / s)
− Panda/View/Widget/SearchBar.hs 
@@ -1,7 +0,0 @@-module Panda.View.Widget.SearchBar where-  -import Panda.Helper.Env hiding (header)-import qualified Panda.Config.Global as G-import Prelude hiding ((/))--search_bar = div_id "search" << form ! [action (G.root / "search"), method "get"] << thediv << textfield "s"
− Panda/View/Widget/Sidebar.hs 
@@ -1,37 +0,0 @@-module Panda.View.Widget.Sidebar where--import Panda.Helper.Env hiding (rss_link)-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Type.State as State--import qualified Data.Set as Set-import qualified Panda.Config.Global as G-import qualified Panda.Type.Sidebar as Sidebar-import Panda.View.Widget.Helper---- model-import qualified Panda.Model.Tag as Tag---- view--sidebar c state = -  div_class_id c "sidebar" << unordList formatted_list-  where-    stock_list = -      [ feed state-      , tag_list $ state.State.tags-      ] -    custom_list = G.sidebar.map (\x -> h2 << x.Sidebar.name +++ x.markup)-    formatted_list = (stock_list ++ custom_list) .intersperse hr--feed state = toHtml-  [ h2 << "Subscribe"-  , p ! [theclass "feed"] << rss_link state-  ]--rss_link = rss_url_link_pair >>> snd-tag_list tags = toHtml-  [ h2 << "Tags"-  , unordList $ tags.Tag.sorted.map tag_link]-  -tag_link x = ( hotlink (G.root / x.Tag.uid) << x.Tag.name ) +++ ( " (" ++ x.Tag.resources.Set.size.show ++ ")" )
− Panda/View/Widget/Template.hs 
@@ -1,33 +0,0 @@-{-# OPTIONS -fno-monomorphism-restriction #-}--module Panda.View.Widget.Template (page) where--import Panda.View.Widget.Head-import Panda.View.Widget.Body-import Panda.View.Widget.Header-import Panda.View.Widget.Navigation-import Panda.View.Widget.Sidebar-import Panda.View.Widget.Footer-import qualified Text.XHtml.Strict as Html-import qualified Panda.Config.Global as G-import qualified Panda.Type.Theme as T--import Panda.Helper.Env hiding (header, body)-import Prelude hiding ((.), (/), (^), id, span)---- extension-import Panda.Extension.Analytics.T--body t state x = Html.body << -  [ div_class (t.T.container) << -    [ header (t.T.header) state-    , navigation (t.T.navigation) state-    , div_id "page" << [ div_class (t.T.main) << body_content x, sidebar (t.T.sidebar) state ]-    , footer (t.T.footer)-    ]-  , primHtml analytics_snippet-  ]--template t state x = [html_head state, body t state x]--page = template G.theme
changelog.markdown view
@@ -1,3 +1,15 @@+2008.10.25+-----------++### Feature++* Modular system: search, comment, analytics are now extensions that can be disabled / enabled++### Fix++* backward compatible with old comment format, no migration required as in 2008.10.24+* works with kibro 4.1+ 2008.10.24 ----------
panda.cabal view
@@ -1,5 +1,5 @@ Name:                 panda-Version:              2008.10.24+Version:              2008.10.25 Build-type:           Simple Synopsis:             A simple static blog engine Description:          A simple static blog engine@@ -10,11 +10,12 @@ Build-Depends:        base Cabal-version:        >= 1.2 category:             Web-homepage:             http://jinjing.blog.easymic.com/static/panda/readme+homepage:             http://www.haskell.org/haskellwiki/Panda 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, gravatar >= 0.3+  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.4.1, utf8-string >= 0.3.1, pandoc >= 0.46, MissingH, parsec >= 2, gravatar >= 0.3+  hs-source-dirs: src/   exposed-modules:  Panda                     Panda.Config.Global @@ -60,5 +61,5 @@                     Panda.View.Widget.Sidebar                     Panda.View.Widget.Template                     - +                    Main
readme.markdown view
@@ -1,3 +1,4 @@ ## Panda: a simple blog engine in Haskell -[Panda homepage](http://www.haskell.org/haskellwiki/Panda)+* [Panda homepage](http://www.haskell.org/haskellwiki/Panda)+* [doc](doc/readme)
+ src/Main.hs view
@@ -0,0 +1,5 @@+module Main where++import Panda++main = panda
+ src/Panda.hs view
@@ -0,0 +1,10 @@+module Panda+  (+    module Panda.Controller.Application,+    panda+  ) where++import Panda.Controller.Application+import Kibro++panda = startKibro pages
+ src/Panda/Config/Global.hs view
@@ -0,0 +1,97 @@+module Panda.Config.Global where++import Panda.Helper.Helper+import MPS+import Prelude hiding ((.), (/), (^), id, readFile)++import System.FilePath hiding ((<.>))+import Control.Arrow ((>>>), (&&&), (***))+import Data.Maybe+import System.Directory++import Panda.Type.Reader+import Panda.Type.Sidebar+import Panda.Type.Theme+import Panda.Type.Extension++db_id       = "db"+flat_id     = "."+post_id     = "blog"+config_id   = "config"+tag_id      = "tag"+comment_id  = "comment"+sidebar_id  = "sidebar"+theme_id    = "theme"++db_uri      = db_id+flat_uri    = db_uri / flat_id++config_uri  = flat_uri / config_id / "site.txt"+sidebar_uri = flat_uri / config_id / sidebar_id+post_uri    = flat_uri / post_id+tag_uri     = flat_uri / tag_id+comment_uri = flat_uri / comment_id+theme_uri   = flat_uri / config_id / theme_id+++-- 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 = parse_config config_uri++config_for' s d = user_config.lookup s .fromMaybe d+config_for s    = config_for' s s++blog_title      = config_for "blog_title"+blog_subtitle   = config_for "blog_subtitle"+host_name       = config_for "host_name"+author_email    = config_for "author_email" ++per_page        = config_for' "per_page" "7" .read :: Int+navigation      = config_for' "navigation" "About" .parse_list.("Home" :)++panda_url       = "http://github.com/nfjinjing/panda"+root            +  | user_root.belongs_to ["/", ""]  = "/"+  | otherwise                       =  user_root.("/" /).remove_trailing_slash+  where user_root = config_for' "root" "/"++default_reader  = Markdown++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"+++-- extensions+analytics_account_id = config_for "analytics_account_id"+extensions = config_for' "extensions" "search, comment, analytics" .parse_list .to_extensions++-- theme+default_theme = blank_theme+user_theme_name = config_for "theme"+user_theme_uri = (theme_uri / user_theme_name) ++ ".txt"++theme = if user_theme_uri.doesFileExist.purify+  then parse_config user_theme_uri .(("name", user_theme_name) : ) .to_theme+  else default_theme+  +-- custom+as_l s                   = "[" ++ s ++ "]"+post_date_format         = config_for' "post_date_format" "%y-%m-%d"+comment_date_format      = config_for' "comment_date_format" "%y-%m-%d %T"+url_date_format          = config_for' "url_date_format" "%y-%m-%d"+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+++
+ src/Panda/Controller/Application.hs view
@@ -0,0 +1,174 @@+-- the controller is the most complex module for a reason:+-- models are made as simple and small as possible+-- views are pure functions.++-- a note on encoding:+-- IOs are in utf-8 filter, internally use bytes++{-# OPTIONS -fno-monomorphism-restriction #-}++module Panda.Controller.Application where++import qualified Data.Map as Map++-- env+import Panda.Helper.Env hiding (tag, uri)+import Panda.Helper.StateHelper+import Prelude hiding ((.), (/), (^), id)+import qualified Panda.Type.State as S+import qualified Panda.Config.Global as G+import qualified Panda.Type.Pager as Pager+import Panda.Type.Extension++-- model+import qualified Panda.Model.Post as Post+import qualified Panda.Model.Static as Static+import qualified Panda.Model.Tag as Tag+import qualified Panda.Model.Comment as Comment++-- view+import qualified Panda.View.Control.Post as PostV+import qualified Panda.View.Widget.Template as T+import qualified Panda.View.Control.Static as StaticV+import qualified Panda.View.Control.Tag as TagV+import qualified Panda.View.Control.Search as SearchV+import qualified Panda.View.Widget.RSS as RSSV++-- helpers+-- liftIO: move to an (u)pper level monad+u = liftIO+blog_regex = G.url_date_matcher++init_post tags x = do+  x.Tag.fill_tag tags.Comment.fill_comment_size.u++tag_list = Tag.list.u+++-- main controller++pages = +  [ ("$"                  ,index              )+  , ("(\\?.+)?$"          ,index              )+  , ("rss.xml$"           ,index_feed         )+  , (blog_regex           ,blog               )+  , ("static/."           ,static             )+  , ("tag/.*/rss.xml$"    ,tag_feed           )+  , ("tag/."              ,tag                )+  , ("search"             ,route_for_extension Search   $ search             )+  , ("comment/create"     ,route_for_extension Comment  $ comment_create     )+  ] .map_fst ((G.root /) >>> ("^" ++))+  +++  [ ("^" ++ G.root ++ "$" ,index              )+  , ("^" ++ G.root ++ "?" ,index              )+  ]+  ++route_for_extension ext x = if has_extension ext then x else not_found++index = do+  posts <- Post.list.u+  p <- paginate posts+  tags <- tag_list+  let nav = if p.Pager.current == 1 then home_nav else no_navigation+  let state = S.empty { S.uid = G.post_id, S.pager = p, S.tags = tags, S.nav_location = nav }+  +  posts.mapM (init_post tags) ^ PostV.list state >>= output_html++index_feed = do+  posts <- Post.list.u+  posts.RSSV.rss "" "" .output++blog = do+  id <- uri ^ Post.uri_to_id+  blog <- Post.get id .u+  comments <- Comment.list_for id .u+  tags <- tag_list+  +  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+  tags <- tag_list+  +  let nav_id = static_page.Static.uid.id_to_resource+  let nav   = if nav_id.belongs_to G.navigation then nav_id else no_navigation+  let state = S.empty { S.uid = id, S.tags = tags, S.nav_location = nav, S.resource_title = static_page.resource_title }+  StaticV.view state static_page .output_html++tag = do+  id <- uri+  tags <- tag_list+  let tag_name = Tag.get_name id+  case Tag.tag_map' tags .Map.lookup tag_name of+    Nothing -> not_found+    Just post_set -> do+      posts <- post_set.to_list.rsort.mapM (Post.get) .u >>= mapM (init_post tags)+      p <- paginate posts+      let state = S.empty { S.uid = id, S.pager = p, S.tags = tags, S.resource_title = tag_name.Tag.resource_title_from_name }+      posts.TagV.view state.output_html++tag_feed = do+  id <- uri ^ (split "/" >>> init >>> join "/")+  tags <- tag_list+  let tag_name = Tag.get_name id+  case Tag.tag_map' tags .Map.lookup tag_name of+    Nothing -> not_found+    Just post_set -> do+      posts <- post_set.to_list.rsort.mapM (Post.get) .u ^ map (Tag.fill_tag tags)+      posts.RSSV.rss G.tag_id tag_name.output++search = do+  s <- param_with_default "s" ""+  posts <- Post.search s .u++  p <- paginate posts+  tags <- tag_list+  query <- uri+  let state = S.empty { S.uid = query, S.pager = p, S.tags = tags, S.resource_title = query }++  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.to_utf8) .doesFileExist .u+  let valid_path = equalFilePath G.post_id (takeDirectory post_id)+  checked <- check_create+  +  if [checked, valid_path, exists].and+    then+      inputs >>= (Comment.create >>> u)+    else+      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 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_data s+  case maybe_s of+    Nothing -> return False+    Just v -> return $ f v
+ src/Panda/Extension/Analytics/T.hs view
@@ -0,0 +1,19 @@+module Panda.Extension.Analytics.T where++import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Config.Global as G++analytics_snippet = +  [ "<script type=\"text/javascript\">                                                                                                  "+  , "var gaJsHost = ((\"https:\" == document.location.protocol) ? \"https://ssl.\" : \"http://www.\");                                  "+  , "document.write(unescape(\"%3Cscript src='\" + gaJsHost + \"google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E\")); "+  , "</script>                                                                                                                          "+  , "<script type=\"text/javascript\">                                                                                                  "+  , "var pageTracker = _gat._getTracker(\"UA-xxxxxx-x\");                                                                               "+  , "pageTracker._trackPageview();                                                                                                      "+  , "</script>                                                                                                                          "+  ]+  .map strip+  .join "\n"+  .gsub "UA-xxxxxx-x" G.analytics_account_id
+ src/Panda/Helper/Env.hs view
@@ -0,0 +1,38 @@+-- this sets some scoping for every module, which prevents importing+-- common modules in every file++module Panda.Helper.Env  (+    module MPS                 +  , module Control.Monad       +  , module Control.Arrow       +  , module Data.List           +  , module Network.URI         +  , module Network.CGI          +  , module System.Locale       +  , module System.Time.Parse+  , module Panda.Helper.Helper+  , module Data.Maybe+  , module System.FilePath+  , module System.IO.UTF8+  , module Text.XHtml.Strict+  , module System.Time+  , module System.Directory+  , module Data.Foldable+) where+  +import MPS hiding (base, col, sub, date)+import Control.Monad hiding (join)+import Control.Arrow ((>>>), (&&&), (***))+import Data.List hiding (find)+import Network.URI+import Network.CGI hiding (Html)+import System.Locale+import System.Time.Parse+import Panda.Helper.Helper+import Data.Maybe+import System.FilePath hiding ((<.>))+import System.IO.UTF8 (readFile, writeFile)+import Text.XHtml.Strict hiding (select)+import System.Time+import System.Directory+import Data.Foldable (find)
+ src/Panda/Helper/Helper.hs view
@@ -0,0 +1,138 @@+-- helper module is a central place for reusable functions+-- for this project, more general helpers are usually moved+-- to MPS package, for multi-project usage++{-# OPTIONS -fno-monomorphism-restriction #-}++module Panda.Helper.Helper where++import System.IO.UTF8 (readFile, writeFile)+import Network.URI+import Network.CGI+import System.FilePath.Posix ((</>))+import Control.Arrow ((>>>), (&&&))+import Text.XHtml.Strict+import Control.Monad hiding (join)+import Data.Maybe+import Panda.Type.Pager as Pager hiding (empty)+import MPS hiding (date)+import Prelude hiding ((.), (/), (^), id, readFile, writeFile)+import Char+import Data.List+import qualified Data.List as L +import Panda.Type.Reader+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++-- controller+raw_uri = requestURI ^ (uriPath >>> urlDecode >>> tail >>> remove_trailing_slash >>> from_utf8 )+remove_trailing_slash s = if s.last.is '/' then s.init else s+  +params = do+  query_string <- requestURI ^ uriQuery +  case query_string of+    '?':s -> s.formDecode .map_snd unescape_unicode_xml.return+    otherwise -> return []++inputs = getInputs ^ map_snd (strip >>> unescape_unicode_xml)++param_with_default s d = params ^ (lookup s >>> fromMaybe d )+input_with_default s d = inputs ^ (lookup s >>> fromMaybe d )++get_param s = params ^ lookup s+get_input s = inputs ^ lookup s++just_param s = get_param s ^ fromJust+just_input s = get_input s ^ fromJust++full_paginate length total = liftM5 ( Pager length ) current has_next has_previous next previous where+  current      = param_with_default "page" "1" ^ read+  has_next     = current ^ ( (* length) >>> (< total.fromIntegral) )+  has_previous = current ^ (> 1)+  next         = current ^ (+ 1)+  previous     = current ^ (+ (-1) )+++for_current_page p xs = xs.drop ((p.Pager.current - 1) * p.Pager.length) .take (p.Pager.length)++-- id: /type/resoruce+id_to_type id     = id.split "/" .first+id_to_resource id = id.split "/" .tail.join "/"+no_navigation     = ""+home_nav          = "Home"+++-- view+id               = identifier++css_link l       = itag "link" ! [rel "stylesheet", thetype "text/css", href l]+js_link l        = itag "script" ! [thetype "text/javascript", src l]+js_src s         = tag "script" ! [thetype "text/javascript"] << s+rss_link l       = itag "link" ! [rel "alternate", thetype "application/rss+xml", href l, title "RSS 2.0"]+favicon_link l   = itag "link" ! [rel "icon", thetype "image/png", href l]+meta_tag         = meta ! [httpequiv "Content-Type", content "text/html; charset=utf-8"]++div_id s         = thediv ! [id s]+div_class s      = thediv ! [theclass s]+div_class_id x y = thediv ! [theclass x, id y]++output_html      = output ... renderHtml++spaced_url = gsub "/" " / "++empty_html = toHtml ""++-- config+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 Resource a where+    resource_title :: a -> String++class Markable a where+    markup :: a -> Html+    +class Datable a where+    date :: a -> CalendarTime++class Addressable a where+    uri :: a -> String++
+ src/Panda/Helper/StateHelper.hs view
@@ -0,0 +1,46 @@+-- trying to merge this helper with the generic one results in cyclic imports++{-# OPTIONS -fno-monomorphism-restriction #-}++module Panda.Helper.StateHelper where++import Panda.Helper.Env+import qualified Panda.Config.Global as G+import Prelude hiding ((.), (/), (^), id)+++-- G.root = /blog+-- raw_uri = blog/x+-- full_uri = /blog/x+-- uri = full_uri - (/blog/)+remove_root s+  | G.root.is "/" = s+  | otherwise     = s.slice (G.root.length) (s.length)++uri = raw_uri ^ remove_root+-- uri = raw_uri+++-- global+parse_date format s = case maybe_d of+  Nothing -> Nothing+  Just d -> Just $ if d.ctYear < 1910 then d {ctYear = d.ctYear + 100} else d +  where+    maybe_d = parseCalendarTime defaultTimeLocale format s+  +format_date          = formatCalendarTime defaultTimeLocale+default_date         = parse_date "%Y-%m-%d %T" "2000-1-1 00:00:00".fromJust+parse_post_date      = parse_date G.post_date_format+default_parse_date s = s.parse_post_date .fromMaybe default_date++has_extension x = G.extensions.has x+for_extension ext x = if has_extension ext then x else toHtml ""++-- 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
+ src/Panda/Model/Comment.hs view
@@ -0,0 +1,109 @@+module Panda.Model.Comment where++-- env+import Panda.Helper.Env hiding (title, body, size, path, meta)+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+  , author :: String+  , body   :: String+  , author_email :: String+  , author_link    :: String+  }+  deriving (Show, Eq)++data CommentData = +    Author+  | AuthorEmail+  | AuthorLink+  | Body+  | PostId+  deriving (Show)++data SpamFilter = +    HumanHack +  | EmptyField+  | LeftNumber+  | RightNumber+  | Operator+  deriving (Show)++instance Resource Comment where+  resource_title = uid >>> spaced_url+  +instance Markable Comment where+  markup x  = render_to_html Markdown (x.body)++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 ^ 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++path id = G.flat_uri / id.to_utf8+meta = (++ ".meta")++get id = do+  meta_exists <- id.path.meta.doesFileExist+  if meta_exists+    then get_from_new_format id+    else get_from_old_format id++get_from_new_format id = do+  body <- id.path.readFile+  meta <- id.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++get_from_old_format id = do+  xs <- id.path.readFile ^ lines+  let author = xs.first+  let author_email = ""+  let author_link = xs.drop 2.first+  let body = xs.drop 4.unlines+  return $ Comment id author body author_email author_link++create h = do+  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+  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) "" "" "" ""++post_id_to_uid x = G.flat_uri / G.comment_id / x.split "/" .last+uid_to_post_id x = G.post_id / x.split "/" .last++fill_comment_size x = do+  size <- x.Post.uid.list_for ^ length +  return $ x { Post.comment_size = size }++gravatar_default_size = size 40+gravatar_link x       = gravatarWith (x.author_email) Nothing gravatar_default_size Nothing
+ src/Panda/Model/Post.hs view
@@ -0,0 +1,78 @@+-- what about the performance?+-- Haskell takes care of that, since IOs are also lazy.+-- Posts are not read unless specifically required, i.e. after pagination++module Panda.Model.Post where++-- env+import Panda.Helper.Env hiding (match, title, body, date)+import qualified MPS as MPS+import Prelude hiding ((.), (/), (^), id, readFile)+import qualified Panda.Config.Global as G+import Panda.Type.Reader+import Panda.Helper.StateHelper hiding (uri)+import Panda.Helper.Helper (date)++data Post = Post +  { uid :: String     -- blog/08-09-04 blog title+  , title :: String+  , body :: String+  , tags :: [String]+  , comment_size :: Int+  , reader :: Reader+  }+  deriving (Show, Eq)++instance Resource Post where+  resource_title = title++instance Markable Post where+  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++-- CRUD+list = ls G.post_uri ^ map from_utf8 ^ rsort ^ map (G.post_id /) >>= mapM get++get id        = liftM4 (Post id (get_title id) ) (get_body id) (return []) (return 0) (return $ get_reader id)+get_extension = takeExtension+get_title id  = id.words.tail.unwords.dropExtension+get_body id   = (G.flat_uri / id.to_utf8) .readFile+get_reader id = id.take_extension.guess_reader.fromMaybe G.default_reader+get_date id   = id.words.first.split "/".last.default_parse_date++match s x = [title, body] .map (send_to x >>> lower >>> isInfixOf (s.lower)) .or+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+  pretty_date     = id.get_date.format_date G.url_date_format+  ext = id.get_extension++uri_to_id s = G.post_id / (d ++ " " ++ t) where+  (raw_d, (prefix, title_with_sep)) = s.MPS.match G.url_date_matcher.fromJust.fst+  raw_t = title_with_sep.drop (G.url_date_title_seperator.length)+  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 empty_html+
+ src/Panda/Model/Static.hs view
@@ -0,0 +1,28 @@+module Panda.Model.Static where++-- env+import Panda.Helper.Env hiding (match, body)+import Prelude hiding ((.), (/), (^), id, readFile)+import qualified Panda.Config.Global as G+import Panda.Type.Reader++data Static = Static +  { uid :: String+  , body :: String+  , reader :: Reader+  }+  deriving (Show, Eq)++instance Resource Static where+  resource_title = uid >>> spaced_url++instance Markable Static where+  markup x = render_to_html (x.reader) (x.body)+  +-- CRUD+get id        = liftM2 (Static id) (get_body id) (return $ get_reader id)+get_title     = id_to_resource >>> dropExtension+get_body id   = (G.flat_uri / id.to_utf8) .readFile+get_reader id = id.take_extension.guess_reader.fromMaybe G.default_reader++title = uid >>> get_title
+ src/Panda/Model/Tag.hs view
@@ -0,0 +1,39 @@+module Panda.Model.Tag where++import qualified Panda.Model.Post as Post++-- env+import Panda.Helper.Env hiding (name)+import Prelude hiding ((.), (/), (^), id, readFile)+import qualified Data.Set as S+import qualified Panda.Config.Global as G+++data Tag = Tag +  { uid :: String     -- tag/name+  , name :: String+  , resources :: S.Set String+  }+  deriving (Show, Eq)++instance Resource Tag where+  resource_title = uid >>> spaced_url++-- CRUD+list             = ls G.tag_uri ^ map from_utf8 ^ map (G.tag_id /) >>= mapM get++get id           = get_resources id ^ Tag id (get_name id)+get_name id      = id.split "/" .tail.join'+get_resources id = (G.flat_uri / id.to_utf8) .readFile+  ^ filter_comment ^ lines ^ map (G.post_id / ) ^ to_set++resource_title_from_name = name_to_id >>> 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) .map name+fill_tag xs x     = x { Post.tags = for_resource xs (x.Post.uid) }++-- extra+sorted xs    = xs.sortBy(compare_by (resources >>> S.size)).reverse+name_to_id x = G.tag_id / x
+ src/Panda/Type/Pager.hs view
@@ -0,0 +1,13 @@+module Panda.Type.Pager where+  +data Pager = Pager {+  length :: Int,+  current :: Int,+  has_next :: Bool,+  has_previous :: Bool,+  next :: Int,+  previous :: Int+  }+  deriving (Eq, Show)+  +empty = Pager 0 0 False False 0 0
+ src/Panda/Type/Reader.hs view
@@ -0,0 +1,37 @@+{-# OPTIONS -XDeriveDataTypeable #-}++module Panda.Type.Reader where++import MPS  +import Prelude hiding ((.), (/), (^), id)+import qualified Data.Map as Map+import Text.Pandoc+import Control.Arrow ((>>>))+import Text.XHtml.Strict+import Data.Generics++data Reader = Markdown | RST | HTML | Latex deriving (Show, Eq, Typeable, Data)++readers = +  [ (Markdown,  ["markdown", "md"])+  , (RST,       ["rst"]  )+  , (HTML,      ["html", "htm"])+  , (Latex,     ["tex", "latex"])+  ]++gen_lookup (r, xs) = xs.labeling (const r)+reader_map         = readers.map gen_lookup.join'.to_h+guess_reader ext   = reader_map.Map.lookup ext+++to_html r      = r defaultParserState >>> writeHtml defaultWriterOptions++-- this list can go on, as long as there is a library that does+-- the convertion. pretty extensible, isn't it.+rr Markdown    = to_html readMarkdown+rr RST         = to_html readRST+rr HTML        = primHtml+rr Latex       = to_html readLaTeX++render_to_html = rr+
+ src/Panda/Type/Sidebar.hs view
@@ -0,0 +1,20 @@+module Panda.Type.Sidebar where++import Panda.Helper.Env hiding (body)+import Prelude hiding ((.), (/), (^), id, readFile)+import Panda.Type.Reader++data SidebarItem = SidebarItem+  { name :: String+  , body :: String+  , reader :: Reader+  }+  deriving (Show, Eq)++instance Markable SidebarItem where+  markup x  = render_to_html (x.reader) (x.body)++read_sidebar_item default_reader s = liftM2 (SidebarItem name) body (return reader) where+  body = s.to_utf8.readFile+  reader = s.take_extension.guess_reader.fromMaybe default_reader+  name = s.takeFileName.dropExtension
+ src/Panda/Type/State.hs view
@@ -0,0 +1,65 @@+module Panda.Type.State where++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+  { uid     :: String       -- current view resource+  , pager   :: Pager.Pager        -- pager++  -- theme state+  , tags    :: [Tag]+  , nav_location :: String+  , resource_title :: String+  , human_test_data :: HumanTestData+  }+  deriving (Show)++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))
+ src/Panda/Type/Theme.hs view
@@ -0,0 +1,44 @@+module Panda.Type.Theme where++import Prelude hiding ((.))+import Panda.Helper.Env hiding (name, header)++data Theme = Theme+  { name        :: String+  , container   :: String+  , header      :: String+  , navigation  :: String+  , main        :: String+  , sidebar     :: String+  , footer      :: String+  , css         :: [String]+  , js          :: [String]+  } deriving (Show, Read)+  +to_theme xs = Theme +  { name        = at "name"+  , container   = at "container"+  , header      = at "header"+  , navigation  = at "navigation"+  , main        = at "main"+  , sidebar     = at "sidebar"+  , footer      = at "footer"+  , css         = at "css" .css_list+  , js          = at "js"  .js_list+  }+  where+    at s = xs.lookup s .fromJust+    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        = ""+  , container   = ""+  , header      = ""+  , navigation  = ""+  , main        = ""+  , sidebar     = ""+  , footer      = ""+  , css         = [""]+  , js          = [""]+  }
+ src/Panda/View/Atom/Comment.hs view
@@ -0,0 +1,66 @@+module Panda.View.Atom.Comment where+  +import Panda.Helper.Env hiding (title)+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++-- model+import Panda.Model.Comment hiding (create)++-- render+instance DataRenderer Comment where+  render_data = entry+  +entry x = toHtml  +  [ 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+    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+human_test_question state = ["What", "is", state.show_left, state.show_op, state.show_right, "?"] .join " "++create state x = toHtml+  [ h2 ! [id "respond"] << "Leave a Response"+  , gui (G.root / "comment/create") ! [id "commentform"] <<+    [ 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_with_value v x' s t m = p <<+  [ label ! [thefor x] << small << m+  , br +  , 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:"
+ src/Panda/View/Atom/Post.hs view
@@ -0,0 +1,39 @@+module Panda.View.Atom.Post where+  +import Panda.Helper.Env hiding (name, title)+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Config.Global as G+import Panda.Helper.StateHelper hiding (uri)++-- view+import qualified Panda.View.Atom.Tag as Tag++-- model+import Panda.Model.Post++-- render+instance DataRenderer Post where+  render_data = entry Full++data RenderStyle = Summary | Full++-- instance helpers+entry style x = div_class "post" << [entry_title, entry_mark, entry_body] where+  entry_title = x.title_link+  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"++post_tags x | x.tags.null = empty_html+post_tags x = " | " +++ "Published in " +++ x.tags.map Tag.tag_link .intersperse (", ".toHtml)++post_comments x | x.comment_size.is 0 = empty_html+post_comments x = " | " +++ hotlink ( x.uri / "#comments") << (x.comment_size.show ++ " Comments")
+ src/Panda/View/Atom/Static.hs view
@@ -0,0 +1,7 @@+module Panda.View.Atom.Static where+  +import Panda.Helper.Env+import Panda.Model.Static++instance DataRenderer Static where+  render_data = markup
+ src/Panda/View/Atom/Tag.hs view
@@ -0,0 +1,12 @@+module Panda.View.Atom.Tag where+  +import Panda.Helper.Env hiding (name)+import Panda.Model.Tag+import qualified Panda.Config.Global as G+import Prelude hiding ((/))++instance DataRenderer Tag where+  render_data = name >>> tag_link++tag_link s = toHtml $ hotlink (G.root / G.tag_id / s ) << s +
+ src/Panda/View/Control/Comment.hs view
@@ -0,0 +1,25 @@+module Panda.View.Control.Comment where+  +import Panda.Helper.Env hiding (body, date)+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Type.State as State++import Panda.Model.Comment hiding (create)+import qualified Panda.Model.Post as Post++-- view+import Panda.View.Control.Helper+import Panda.View.Widget.Template+import Panda.View.Atom.Comment as Comment+++-- api+styled_entry alt x = li ! [theclass alt] << x.render_data++list [] = []+list xs = +  [ h2 ! [id "comments"] << "Responses"+  , olist ! [theclass "commentlist" ] << xs.zip (cycle ["comments-alt", ""]).map (splash styled_entry)+  ]+  +create = Comment.create
+ src/Panda/View/Control/Helper.hs view
@@ -0,0 +1,26 @@+module Panda.View.Control.Helper where++import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+  +import Panda.Type.Pager as Pager+import qualified Panda.Config.Global as G+++nav p r = +  [ div_class "alignleft" << nav_previous p r+  , div_class "alignright" << nav_next p r+  ]+  +nav_previous p r = if p.Pager.has_previous +  then toHtml $ hotlink ( r' ++ "page=" ++ p.Pager.previous.show ) << previous_sign+  else spaceHtml+  where r' = if isSuffixOf "&" r then r else r ++ "?"+    +nav_next p r = if p.Pager.has_next+  then toHtml $ hotlink ( r' ++ "page=" ++ p.Pager.next.show ) << next_sign+  else spaceHtml+  where r' = if isSuffixOf "&" r then r else r ++ "?"++next_sign     = "Next Entries »"+previous_sign = "« Previous Entries"
+ src/Panda/View/Control/Post.hs view
@@ -0,0 +1,30 @@+module Panda.View.Control.Post where++-- env+import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)++import qualified Panda.Type.State as State+import qualified Panda.Config.Global as G++import Panda.Type.Extension+import Panda.Helper.StateHelper++-- model+import qualified Panda.Model.Comment as Comment+import Panda.View.Atom.Post+import Panda.Model.Post++-- view+import Panda.View.Control.Helper+import qualified Panda.View.Control.Comment as CommentV+import Panda.View.Widget.Template++-- entry view+view state xs x = (x.render_data +++ comment_view ).page state+  where comment_view = for_extension Comment $ CommentV.list xs +++ CommentV.create state (x.uid.Comment.from_post_id)++-- list view+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
+ src/Panda/View/Control/Search.hs view
@@ -0,0 +1,15 @@+module Panda.View.Control.Search where+  +import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Type.State as State+import qualified Panda.Config.Global as G++-- view+import Panda.View.Atom.Post+import Panda.View.Control.Helper+import Panda.View.Widget.Template++view state s = for_current_page p >>> map render_data >>> (+++ nav p ( (G.root / "search") ++ "?s=" ++ s ++ "&")) >>> page state+  where p = state.State.pager+
+ src/Panda/View/Control/Static.hs view
@@ -0,0 +1,7 @@+module Panda.View.Control.Static where+  +import Panda.Helper.Env+import Panda.View.Atom.Static+import Panda.View.Widget.Template++view state = render_data >>> page state
+ src/Panda/View/Control/Tag.hs view
@@ -0,0 +1,18 @@+module Panda.View.Control.Tag where+  +import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Type.State as State+import qualified Panda.Config.Global as G++-- view+import Panda.View.Atom.Post+import Panda.View.Control.Helper+import Panda.View.Widget.Template+++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+
+ src/Panda/View/Widget/Body.hs view
@@ -0,0 +1,8 @@+module Panda.View.Widget.Body where++-- env+import Panda.Helper.Env++body_content x = div_id "maincontent" <<+  div_class "content" << x+
+ src/Panda/View/Widget/Footer.hs view
@@ -0,0 +1,17 @@+module Panda.View.Widget.Footer where+  +import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Config.Global as G+++footer c = div_class_id c "footer" <<+  [ toHtml $ copyright+  , toHtml $ "2008 "+  , toHtml $ G.blog_title+  , toHtml $ br+  , toHtml $ "Powered by "+  , toHtml $ hotlink G.panda_url << "Panda"+  , toHtml $ " using "+  , toHtml $ hotlink "http://www.haskell.org/" << "Haskell"+  ]
+ src/Panda/View/Widget/Head.hs view
@@ -0,0 +1,17 @@+module Panda.View.Widget.Head where++import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Config.Global as G+import Panda.Type.Theme hiding (header)+import qualified Panda.Type.State as S+import Panda.View.Widget.Helper++html_head state = header << ([meta_tag, title_tag state, favicon_tag, rss_tag state] ++ G.theme.css.map css_link ++ G.theme.js.map js_link )++title_tag state = thetitle << [G.blog_title ++ state.S.resource_title.format_title]+rss_tag state   = rss_link $ rss_url_link_pair state .fst+favicon_tag = favicon_link G.favicon++format_title [] = ""+format_title s = " / " ++ s
+ src/Panda/View/Widget/Header.hs view
@@ -0,0 +1,18 @@+module Panda.View.Widget.Header where+  +import Panda.Helper.Env hiding (header)+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Config.Global as G+import Panda.View.Widget.SearchBar++header c state =+  div_class_id c "header" << +    [ search_bar+    , site_name+    ]++site_name = toHtml $+  [ toHtml $ hotlink G.root ! [theclass "logo"] << ""+  , h1 << G.blog_title+  , div_class "description" << G.blog_subtitle+  ]
+ src/Panda/View/Widget/Helper.hs view
@@ -0,0 +1,20 @@+module Panda.View.Widget.Helper where++import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+  +import qualified Panda.Config.Global as G+import qualified Panda.Type.State as State+import qualified Panda.Model.Tag as Tag++rss_url_link_pair state = +  if tagged +  then+    let tag_name = Tag.get_name uid in+      link ( G.tag_id / tag_name) tag_name+  else link "" "Home"+  where+    uid = State.uid state+    tagged = uid.match "^tag/.+" .isJust+    url r = G.root / r / "rss.xml"+    link r s = (url r, hotlink (url r) ! [ theclass "feedlink" ] << s)
+ src/Panda/View/Widget/Navigation.hs view
@@ -0,0 +1,19 @@+module Panda.View.Widget.Navigation where+  +import Panda.Helper.Env hiding (header)+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Config.Global as G+import qualified Panda.Type.State as State++navigation c state = +  div_class_id c "nav" <<+    div_class "content" <<+      ulist << G.navigation.map (nav_item (state.State.nav_location))++nav_item nav s = li ! [theclass (home_tag ++ "page_item" ++ current)] << link s where+  home_tag = if s == home_nav then "first " else ""+  current = if s == nav then " current_page_item" else ""+  link x = if x == home_nav then home_link else static_link x++home_link     = hotlink G.root << home_nav+static_link s = hotlink (G.root / "static" / s) << s.dropExtension
+ src/Panda/View/Widget/RSS.hs view
@@ -0,0 +1,37 @@+module Panda.View.Widget.RSS where++-- env+import Panda.Helper.Env -- hiding (Language)+import Prelude hiding ((.), (/), (^), id)+import qualified Panda.Config.Global as G+import qualified Panda.Type.Pager as Pager+import Text.RSS+import qualified Text.RSS as RSS++-- model+import Panda.Model.Post as Post++-- 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.render_rss+  , Author $ G.author_email+  , Link $ x.item_uri+  , PubDate $ x.date+  ]++item_uri x = nullURI { uriScheme = "http://", uriPath = host_link (x.uri) }+rss_uri x  = nullURI { 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)+  .rssToXML.showXML+  where+    link = categary / s+    title = if s.empty then G.blog_title else G.blog_title ++ " / " ++ s++host_link s = G.host_name ++ (G.root / s)
+ src/Panda/View/Widget/SearchBar.hs view
@@ -0,0 +1,9 @@+module Panda.View.Widget.SearchBar where+  +import Panda.Helper.Env hiding (header)+import qualified Panda.Config.Global as G+import Prelude hiding ((/))+import Panda.Type.Extension+import Panda.Helper.StateHelper++search_bar = for_extension Search $ div_id "search" << form ! [action (G.root / "search"), method "get"] << thediv << textfield "s"
+ src/Panda/View/Widget/Sidebar.hs view
@@ -0,0 +1,37 @@+module Panda.View.Widget.Sidebar where++import Panda.Helper.Env hiding (rss_link)+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Type.State as State++import qualified Data.Set as Set+import qualified Panda.Config.Global as G+import qualified Panda.Type.Sidebar as Sidebar+import Panda.View.Widget.Helper++-- model+import qualified Panda.Model.Tag as Tag++-- view++sidebar c state = +  div_class_id c "sidebar" << unordList formatted_list+  where+    stock_list = +      [ feed state+      , tag_list $ state.State.tags+      ] +    custom_list = G.sidebar.map (\x -> h2 << x.Sidebar.name +++ x.markup)+    formatted_list = (stock_list ++ custom_list) .intersperse hr++feed state = toHtml+  [ h2 << "Subscribe"+  , p ! [theclass "feed"] << rss_link state+  ]++rss_link = rss_url_link_pair >>> snd+tag_list tags = toHtml+  [ h2 << "Tags"+  , unordList $ tags.Tag.sorted.map tag_link]+  +tag_link x = ( hotlink (G.root / x.Tag.uid) << x.Tag.name ) +++ ( " (" ++ x.Tag.resources.Set.size.show ++ ")" )
+ src/Panda/View/Widget/Template.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS -fno-monomorphism-restriction #-}++module Panda.View.Widget.Template (page) where++import Panda.View.Widget.Head+import Panda.View.Widget.Body+import Panda.View.Widget.Header+import Panda.View.Widget.Navigation+import Panda.View.Widget.Sidebar+import Panda.View.Widget.Footer+import qualified Text.XHtml.Strict as Html+import qualified Panda.Config.Global as G+import qualified Panda.Type.Theme as T++import Panda.Helper.Env hiding (header, body)+import Prelude hiding ((.), (/), (^), id, span)++-- extension+import Panda.Extension.Analytics.T+import Panda.Type.Extension+import Panda.Helper.StateHelper++body t state x = Html.body << +  [ div_class (t.T.container) << +    [ header (t.T.header) state+    , navigation (t.T.navigation) state+    , div_id "page" << [ div_class (t.T.main) << body_content x, sidebar (t.T.sidebar) state ]+    , footer (t.T.footer)+    ]+  , for_extension Analytics $ primHtml analytics_snippet+  ]++template t state x = [html_head state, body t state x]++page = template G.theme