packages feed

panda 2008.11.7 → 2008.12.14

raw patch · 19 files changed

+330/−145 lines, 19 filesdep +process

Dependencies added: process

Files

changelog.markdown view
@@ -1,3 +1,10 @@+2008.12.14+----------++### Feature++* Photo album plugin+ 2008.11.7 ---------
panda.cabal view
@@ -1,5 +1,5 @@ Name:                 panda-Version:              2008.11.7+Version:              2008.12.14 Build-type:           Simple Synopsis:             A simple static blog engine Description:          A simple static blog engine@@ -11,11 +11,11 @@ Cabal-version:        >= 1.2 category:             Web homepage:             http://www.haskell.org/haskellwiki/Panda-data-files:			  readme.markdown, changelog.markdown+data-files:           readme.markdown, changelog.markdown  library   ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-type-defaults-  build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, mps >= 2008.11.6, parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, kibro >= 0.4.2, utf8-string >= 0.3.3, pandoc, parsec >= 2, MissingH, gravatar >= 0.3, data-default >= 0.2, hcheat >= 2008.11.6+  build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, process, mps >= 2008.11.6, parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, kibro >= 0.4.2, utf8-string >= 0.3.3, pandoc, parsec >= 2, MissingH, gravatar >= 0.3, data-default >= 0.2, hcheat >= 2008.11.6   hs-source-dirs: src/   exposed-modules:                       Panda@@ -28,6 +28,7 @@                     Panda.Helper.Helper                     Panda.Helper.PreludeEnv                     Panda.Helper.StateHelper+                    Panda.Helper.ThumbHelper                      Panda.Model.Comment                     Panda.Model.Post
src/Panda/Config/Global.hs view
@@ -5,7 +5,7 @@ import Panda.Helper.Helper import Panda.Helper.PreludeEnv -import Control.Arrow ((>>>))+ import Data.Maybe import Data.Default @@ -23,9 +23,17 @@ sidebar_id     = "sidebar" theme_id       = "theme" config_file_id = "site.txt"+album_id       = "album"+image_id       = "images"+public_id      = "public"+static_id      = "static"+topic_id       = "forum/post"+thumb_id       = "thumb"  db_uri         = db_id flat_uri       = db_uri / flat_id+public_uri     = db_uri / public_id+image_uri      = public_uri / image_id  config_uri     = flat_uri / config_id / config_file_id sidebar_uri    = flat_uri / config_id / sidebar_id@@ -35,6 +43,9 @@ comment_uri    = flat_uri / comment_id theme_uri      = flat_uri / config_id / theme_id +album_uri      = image_uri / album_id+topic_uri      = flat_uri / topic_id+ data ConfigData =      BlogTitle   | BlogSubtitle@@ -59,6 +70,8 @@   | SummaryForRoot   | SummaryForTag   | SummaryForRss+  | PicturePrefix+  | NumberOfLatestPosts   deriving (Show)    -- unsafe, must restart server after changing config file, sorry about that ...@@ -76,7 +89,7 @@ author_email  = for AuthorEmail  per_page      = for_int' PerPage "7"-navigation    = for_list' Navigation "About" .("Home" :)+navigation    = for_list' Navigation "About" .(home_nav :)  panda_url     = "http://www.haskell.org/haskellwiki/Panda" @@ -87,8 +100,8 @@  default_reader  = def -load_widget = read_static_widget default_reader >>> purify-sidebar = for_list' Sidebar "" .map (sidebar_uri /).select (file_exist >>> purify )+load_widget = read_static_widget default_reader > purify+sidebar = for_list' Sidebar "" .map (sidebar_uri /).select (file_exist > purify )   .map load_widget  footer  = for Footer @@ -121,10 +134,13 @@  -- summary cut              = for' Cut "✂-----"-parse_boolean    = belongs_to ["true", "1", "y", "yes", "yeah"] summary_for_root = for SummaryForRoot .parse_boolean summary_for_tag  = for SummaryForTag  .parse_boolean summary_for_rss  = for SummaryForRss  .parse_boolean +-- album+picture_prefix = for' PicturePrefix "\\d+-" +-- latest+number_of_latest_posts = for_int' NumberOfLatestPosts "15"
src/Panda/Controller/Application.hs view
@@ -38,12 +38,12 @@ u                = liftIO blog_regex       = G.url_date_matcher init_post tags x = x.Tag.fill_tag tags.Comment.fill_comment_size.u-tag_list         = Tag.list.u+tag_list         = list.u   -- main controller -pages = +pages = (   [ ("$"                  ,index                                  )   , ("(\\?.+)?$"          ,index                                  )   , ("rss.xml$"           ,index_feed                             )@@ -53,47 +53,52 @@   , ("tag/."              ,tag                                    )   , ("search"             ,only_for Search   $ search             )   , ("comment/create"     ,only_for Comment  $ comment_create     )-  ] .map_fst ((G.root /) >>> ("^" ++))+  ] .map_fst ((G.root /) > ("^" ++))   ++   [ ("^" ++ G.root ++ "$" ,index                                  )   , ("^" ++ G.root ++ "?" ,index                                  )-  ]-  +  ] ).map_snd (set_header >>)  only_for ext x = if has_extension ext then x else not_found +default_state = do+  latest_posts <- Post.latest G.number_of_latest_posts.u+  def { S.latest_posts = latest_posts } .return+ index = do-  posts <- Post.list.u+  posts <- list.u   p <- paginate posts   tags <- tag_list   let nav = if p.Pager.current == 1 then home_nav else no_navigation-  let state = def { S.uid = G.post_id, S.pager = p, S.tags = tags, S.nav_location = nav }+  s <- default_state+  let state = s { S.uid = G.post_id, S.tags = tags, S.pager = p, S.nav_location = nav }      posts.mapM (init_post tags) ^ PostV.list state >>= output_html  index_feed = do-  posts <- Post.list.u+  posts <- 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+  blog <- get id .u+  comments <- list_for id .u   tags <- tag_list      test_data <- S.mk_human_test .u-  let state = def { S.uid = id, S.tags = tags, S.resource_title = blog.resource_title, S.human_test_data = test_data }+  s <- default_state+  let state = s { 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+  static_page <- 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 = def { S.uid = id, S.tags = tags, S.nav_location = nav, S.resource_title = static_page.resource_title }+  s <- default_state+  let state = s { 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@@ -103,19 +108,20 @@   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)+      posts <- post_set.to_list.rsort.mapM (get) .u >>= mapM (init_post tags)       p <- paginate posts-      let state = def { S.uid = id, S.pager = p, S.tags = tags, S.resource_title = tag_name.Tag.resource_title_from_name }+      s <- default_state+      let state = s { S.uid = id, S.tags = tags, S.pager = p, S.resource_title = tag_name.Tag.resource_title_from_name }       posts.TagV.view state.output_html  tag_feed = do-  id <- uri ^ (split "/" >>> init >>> join "/")+  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 <- post_set.to_list.rsort.mapM (get) .u ^ map (Tag.fill_tag tags)       posts.RSSV.rss G.tag_id tag_name.output  search = do@@ -125,7 +131,8 @@   p <- paginate posts   tags <- tag_list   query <- uri-  let state = def { S.uid = query, S.pager = p, S.tags = tags, S.resource_title = query }+  s' <- default_state+  let state = s' { 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 @@ -137,12 +144,12 @@      if [checked, valid_path, exists].and     then-      inputs >>= (Comment.create >>> u)+      inputs >>= (Comment.create_comment > u)     else       return ()   redirect $ (post_id.Post.id_to_uri.u2b).urlEncode -get_input_data = show_data >>> get_input+get_input_data = show_data > get_input  check_human = do   [l, r, op, h] <- [Comment.LeftNumber, Comment.RightNumber, Comment.Operator, Comment.HumanHack].mapM get_input_data ^ map fromJust@@ -150,9 +157,9 @@  -- create helper, should be refactored to some common aspect check_create =-  [ validate Comment.Author       ( length >>> (> 0))+  [ validate Comment.Author       ( length > (`gt` 0))   , validate Comment.AuthorLink   ( const True)-  , validate Comment.Body         ( length >>> (> 0))+  , validate Comment.Body         ( length > (`gt` 0))   , validate Comment.EmptyField   ( empty )   , validate Comment.LeftNumber   ( belongs_to (S.nums.map show))   , validate Comment.RightNumber  ( belongs_to (S.nums.map show))
src/Panda/Helper/Env.hs view
@@ -35,7 +35,7 @@ import Data.Maybe (fromMaybe, fromJust, isJust, isNothing) import System.FilePath hiding ((<.>)) import System.IO.UTF8 (readFile, writeFile)-import Text.XHtml.Strict hiding (select)+import Text.XHtml.Strict hiding (select, sub, meta) import System.Time import System.Directory import Data.Foldable (find)
src/Panda/Helper/Helper.hs view
@@ -10,8 +10,9 @@ import Panda.Helper.PreludeEnv import Network.URI import Network.CGI-import Control.Arrow ((>>>))-import Text.XHtml.Strict hiding (p)++import Text.XHtml.Strict hiding (p, meta)+import qualified Text.XHtml.Strict as Html import Control.Monad hiding (join) import Data.Maybe import qualified Panda.Type.Pager as Pager@@ -21,28 +22,47 @@ import Panda.Type.Reader import System.FilePath.Posix hiding ((<.>)) import System.Time+import qualified Prelude as P+import Data.Default+import Data.Map (Map)+import System.Directory  (/) :: FilePath -> FilePath -> FilePath (/) = (</>) infixl 5 / +gt = (P.>)+ -- global parse_config_io s = read_file 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+parse_config         = parse_config_io > purify write_config_io s xs = xs.map(\(x, y) -> x ++ " = " ++ y) .join "\n" .write_file s  -- model-take_extension = takeExtension >>> split "\\." >>> last+take_extension = takeExtension > split "\\." > last+take_known_extension s +  | ext.belongs_to exts = ext+  | otherwise = ""+  where +    ext = s.take_extension+    exts = readers.only_snd.join'+ drop_known_extension s   | s.take_extension.belongs_to exts = dropExtension s   | otherwise = s   where exts = readers.only_snd.join' +meta = (++ ".meta")++image_extensions = ["jpg", "jpeg", "png", "gif"]+is_image x = image_extensions.any (suffix_of x)+suffix_of = flip isSuffixOf+ -- controller-raw_uri = requestURI ^ (uriPath >>> urlDecode >>> tail >>> remove_trailing_slash )+raw_uri = requestURI ^ (uriPath > urlDecode > tail > remove_trailing_slash )  remove_trailing_slash s = if s.last.is '/' then s.init else s @@ -52,7 +72,7 @@     '?':s -> s.formDecode .map_snd ( unescape_unicode_xml ) .return     _ -> return [] -inputs = getInputs ^ map_snd (strip >>> unescape_unicode_xml)+inputs = getInputs ^ map_snd (strip > unescape_unicode_xml > b2u)  param_with_default s d = get_param s ^ fromMaybe d input_with_default s d = get_input s ^ fromMaybe d@@ -65,63 +85,103 @@  full_paginate length total = liftM5 ( Pager.Pager length ) current has_next has_previous next previous where   current      = param_with_default "page" "1" ^ read-  has_next     = current ^ ( (* length) >>> (< total.from_i) )-  has_previous = current ^ (> 1)+  has_next     = current ^ ( (* length) > (< total.from_i) )+  has_previous = current ^ (`gt` 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 x     = x.split "/" .first-id_to_resource x = x.split "/" .tail.join "/" no_navigation     = "" home_nav          = "Home" +default_content_type = "text/html; charset=UTF-8"+set_content_type = setHeader "Content-type"+set_header = set_content_type default_content_type  -- view id               = identifier  css_link l       = itag "link" ! [rel "stylesheet", thetype "text/css", href l]+ie_tag x         = ("<!--[if IE]>" ++ x.show ++ "<![endif]-->").primHtml+ie6_tag x        = ("<!--[if lt IE 7]>" ++ x.show ++ "<![endif]-->").primHtml+ie7_tag x        = ("<!--[if IE 7]>" ++ x.show ++ "<![endif]-->").primHtml 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"]+meta_tag         = Html.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+xml_header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"+output_html x   = x.renderHtml.output  spaced_url = gsub "/" " / "  empty_html = toHtml ""+html_if p x = if p then x else empty_html  -- config parse_list s = s.split "," .map strip .reject null-not_found = getVar "REQUEST_URI" >>= (fromMaybe "" >>> outputNotFound)+not_found = getVar "REQUEST_URI" >>= (fromMaybe "" > outputNotFound)   -- generic-show_data = show >>> snake_case+show_data = show > snake_case+ifM p t f  = p >>= (\p' -> if p' then t else f)+parse_boolean = belongs_to ["true", "1", "y", "yes", "yeah"]+mkdir = u2b > createDirectory  -- class class DataRenderer a where-    render_data :: a -> Html+  render_data :: a -> Html -class Resource a where-    resource_title :: a -> String+-- id: /type/resoruce+id_to_type x     = x.split "/" .first+id_to_resource x = x.split "/" .tail.join "/"+  +class (Show a) => Resource a where+  resource_title :: a -> String+  resource_type :: a -> String+  resource_type = show_data  class Markable a where-    markup :: a -> Html+  markup :: a -> Html      class Datable a where-    date :: a -> CalendarTime+  date :: a -> CalendarTime  class Addressable a where-    uri :: a -> String+  uri :: a -> String++-- class Pluggable a where+--   render_plugin :: a -> String++class Gettable a where+  get :: String -> IO a++type Assoc = [(String, String)]+  +class Mappable a where+  from_assoc :: Assoc -> IO a++class Creatable a where+  create :: a -> IO ()++class Listable a where+  list :: IO [a]+  list = return []+  +  list_for :: String -> IO [a]+  list_for = const list+  cheat_list :: IO [a]+  cheat_list = list++class FlatRead a where+  flat_read :: String -> IO a
src/Panda/Helper/PreludeEnv.hs view
@@ -1,10 +1,18 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE NoImplicitPrelude, NoMonomorphismRestriction #-}  module Panda.Helper.PreludeEnv  (     module MPSUTF8   , module Prelude+  , (>)+  , strip ) where -import Prelude hiding ((.), (/), (^), id, span, readFile, writeFile)-import MPSUTF8 hiding (base, col, date, sub)+import Prelude hiding ((.), (/), (^), id, span, readFile, writeFile, div, (>))+import MPSUTF8 hiding (base, col, date, strip)+import qualified MPSUTF8 as MPS+import Control.Arrow ((>>>)) +(>) = (>>>)+infixl 8 >++strip x = MPS.strip (x.u2b) .b2u
src/Panda/Helper/StateHelper.hs view
@@ -19,7 +19,6 @@ uri = raw_uri ^ b2u ^ remove_root -- uri = raw_uri - -- global parse_date format s = case maybe_d of   Nothing -> Nothing@@ -36,10 +35,14 @@ only_for ext x = if has_extension ext then x else toHtml ""  -- controller-paginate = length >>> full_paginate (G.per_page)+paginate = length > full_paginate (G.per_page)  cut       = G.cut cut_re    = "^\\s*" ++ cut-match_cut = match cut_re-is_cut    = match_cut >>> isJust+match_cut = is_cut+is_cut =    isInfixOf cut split_cut = split cut_re+++-- model+path id = G.flat_uri / id
+ src/Panda/Helper/ThumbHelper.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Panda.Helper.ThumbHelper where++-- env+import Panda.Helper.Env hiding (match, body, quote)+import qualified Panda.Config.Global as G+import System.Cmd++convert_if_missing_thumb w x = do+  thumb_exists <- dir_exist (thumb_path)+  if thumb_exists+    then return ()+    else mkdir thumb_path >> convert w x +  +  where+    thumb_path = x / G.thumb_id++convert w x = do+  images <- ls x ^ filter is_image+  images.map (convert_cmd w x).sequence >>= print+  return ()++quote x = "\"" ++ x ++ "\""++system_utf8 = u2b > system++convert_cmd w p x = do+  system_utf8 $ ["convert -resize", w.show, i, o].join " ".trace'+  where+    i = quote $ p / x +    o = quote $ p / G.thumb_id / x
src/Panda/Model/Comment.hs view
@@ -3,7 +3,7 @@ module Panda.Model.Comment where  -- env-import Panda.Helper.Env hiding (title, body, size, path, meta)+import Panda.Helper.Env hiding (title, body, size, path) import qualified Panda.Config.Global as G import Panda.Type.Reader import qualified Panda.Model.Post as Post@@ -36,7 +36,7 @@   deriving (Show)  instance Resource Comment where-  resource_title = uid >>> spaced_url+  resource_title = uid > spaced_url    instance Markable Comment where   markup x  = render_to_html Markdown (x.body)@@ -48,55 +48,64 @@   def = Comment def def def def def  -- CRUD-list_for post_id = do-  has_comments <- dir_exist d-  if has_comments-    then ls d ^ reject (isSuffixOf ".meta") ^ rsort ^ map (G.comment_id / r /) >>= mapM get-    else return []-  where-    d = (G.comment_uri / r)-    r = post_id.id_to_resource+instance FlatRead Comment where+  flat_read x = do+    t <- x.path.read_file+    def {body = t, uid = x} .return -path id = G.flat_uri / id-meta = (++ ".meta")+instance Gettable Comment where+  get id = do+    x <- flat_read id+    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+    x { author = author, author_email = author_email, author_link = author_link } .return -get id = do-  meta_exists <- id.path.meta.file_exist-  if meta_exists-    then get_from_new_format id-    else get_from_old_format id+instance Listable Comment where+  list_for resource_id = do+    ifM (dir_exist d) (idsM >>= mapM (get :: String -> IO Comment)) (return [])+    where+      idsM = ls d ^ reject (isSuffixOf ".meta") ^ rsort ^ map (G.comment_id / r /)+      d = (G.comment_uri / r)+      r = resource_id.id_to_resource -get_from_new_format id = do-  body <- id.path.read_file-  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 +instance Creatable Comment where+  create = write_to -get_from_old_format id = do-  xs <- id.path.read_file ^ 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+instance Mappable Comment where+  from_assoc h = do+    let at s    = h.lookup (s.show_data) .fromJust+    let body    = at Body+    let post_id = at PostId -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 +    mkdir_p comment_path -  timestamp <- ( getClockTime >>= toCalendarTime ) ^ format_date G.comment_date_format-  let comment_path = post_id_to_uid post_id -  mkdir_p comment_path-  -  let uid = comment_path / timestamp-  write_file uid body-  let meta = [Author, AuthorLink, AuthorEmail] .labeling at .map_fst show_data-  write_config_io (uid ++ ".meta") meta+    let uid  = comment_path / timestamp+    def +      { uid = uid+      , body = at Body+      , author = at Author+      , author_email = at AuthorEmail+      , author_link = at AuthorLink+      }+      .return +write_to x = do+  write_file (x.uid) (x.body)+  write_config_io (x.uid.meta) meta_data+  where+    meta_data = +      [ (Author, x.author)+      , (AuthorLink, x.author_link)+      , (AuthorEmail, x.author_email)+      ] .map_fst show_data++create_comment x = x.from_assoc >>= (create :: Comment -> IO ())+ -- extra from_post_id x = def { uid = post_id_to_uid x } @@ -104,7 +113,7 @@ uid_to_post_id x = G.post_id / x.split "/" .last  fill_comment_size x = do-  size <- x.Post.uid.list_for ^ length +  size <- x.Post.uid.(list_for :: String -> IO [Comment] ) ^ length    return $ x { Post.comment_size = size }  gravatar_default_size = size 40
src/Panda/Model/Post.hs view
@@ -13,7 +13,9 @@ import Panda.Type.Reader import Panda.Helper.StateHelper hiding (uri) import Panda.Helper.Helper (date)+import Panda.Model.Helper + data Post = Post    { uid :: String     -- blog/08-09-04 blog title   , title :: String@@ -26,44 +28,65 @@  instance Resource Post where   resource_title = title+  resource_type = const G.post_id  instance Markable Post where   markup x  = render_to_html (x.reader) (x.full)    instance Datable Post where-  date = uid >>> get_date+  date = uid > get_date  instance Addressable Post where-  uri = uid >>> id_to_uri+  uri = uid > id_to_uri +instance Default Post where+  def = Post def def def def def def++instance FlatRead Post where+  flat_read x = do+    t <- get_body x+    def {body = t, uid = x} .return+ -- CRUD-list = ls G.post_uri ^ rsort ^ map (G.post_id /) >>= mapM get+instance Gettable Post where+  get id = do+    x <- flat_read id+    x {+        title = get_title id+      , reader = get_reader id+      }+      .return -get id        = liftM4 (Post id (get_title id) ) (get_body id) (return []) (return 0) (return $ get_reader id)-get_extension = takeExtension+instance Listable Post where+  list = list_ids >>= mapM get+  cheat_list = fast_list++list_ids = ls G.post_uri ^ rsort ^ map (G.post_id /)+fast_list = list_ids ^ map (\x -> def {uid = x, title = x.get_title})++ get_title id  = id.words.tail.unwords.drop_known_extension-get_body id   = (G.flat_uri / id) .read_file-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+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-full x | x.body.match_cut.isNothing = x.body+summary x = x.body.lines.takeWhile (is_cut > not) .unlines+full x | x.body.match_cut.not = x.body full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).unlines where-  not_cut = is_cut >>> not+  not_cut = is_cut > not   xs = x.body.lines -has_continue = body >>> match_cut >>> isJust+has_continue = body > match_cut +latest n = cheat_list ^ take n  -- 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+  ext = id.take_known_extension  uri_to_id s = G.post_id / (d ++ " " ++ t) where   (raw_d, (_, title_with_sep)) = s.MPS.match G.url_date_matcher.fromJust.fst@@ -74,6 +97,8 @@  -- 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+  post_summary = (reader &&& summary) > splash render_to_html+  next = if x.has_continue then toHtml $ p << hotlink (x.uri) << "Read the rest of the post »" else empty_html   ++
src/Panda/Model/Static.hs view
@@ -5,6 +5,7 @@ import Panda.Helper.Env hiding (match, body) import qualified Panda.Config.Global as G import Panda.Type.Reader+import Panda.Model.Helper  data Static = Static    { uid :: String@@ -14,15 +15,24 @@   deriving (Show, Eq)  instance Resource Static where-  resource_title = uid >>> spaced_url+  resource_title x = ("static" / x.uid.get_title) .spaced_url  instance Markable Static where   markup x = render_to_html (x.reader) (x.body)-  ++instance Default Static where+  def = Static def def def+ -- CRUD-get id        = liftM2 (Static id) (get_body id) (return $ get_reader id)-get_title     = id_to_resource >>> drop_known_extension-get_body id   = (G.flat_uri / id) .read_file-get_reader id = id.take_extension.guess_reader.fromMaybe G.default_reader+instance FlatRead Static where+  flat_read x = do+    t <- get_body x+    def {body = t, uid = x} .return -title = uid >>> get_title+instance Gettable Static where+  get id = do+    x <- flat_read id+    x { reader = get_reader id } .return++get_title     = id_to_resource > drop_known_extension > split "/" > last+title = uid > get_title
src/Panda/Model/Tag.hs view
@@ -17,23 +17,27 @@   deriving (Show, Eq)  instance Resource Tag where-  resource_title = uid >>> spaced_url+  resource_title = uid > spaced_url  -- CRUD-list             = ls G.tag_uri ^ map (G.tag_id /) >>= mapM get+instance Gettable Tag where+  get id           = get_resources id ^ Tag id (get_name id) -get id           = get_resources id ^ Tag id (get_name id)+instance Listable Tag where+  list             = ls G.tag_uri ^ map (G.tag_id /) >>= mapM get++ get_name id      = id.split "/" .tail.join' get_resources id = (G.flat_uri / id) .read_file   ^ filter_comment ^ lines ^ map (G.post_id / ) ^ to_set -resource_title_from_name = name_to_id >>> spaced_url+resource_title_from_name x = ("tag" / x) .spaced_url tag_map' xs       = xs . map (name &&& resources) . to_h tag_map           = list ^ tag_map' -for_resource xs x = xs.select (resources >>> has x) .map name+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+sorted xs    = xs.sortBy(compare_by (resources > S.size)).reverse name_to_id x = G.tag_id / x
src/Panda/Type/Reader.hs view
@@ -5,9 +5,10 @@ import Panda.Helper.PreludeEnv import qualified Data.Map as Map import Text.Pandoc-import Control.Arrow ((>>>))+ import Text.XHtml.Strict import Data.Default+import Panda.Helper.Html  data Reader = Markdown | RST | HTML | Latex deriving (Show, Eq) @@ -27,14 +28,14 @@  guess_reader ext = reader_map.Map.lookup ext -to_html r = r defaultParserState >>> writeHtml defaultWriterOptions+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 :: Reader -> String -> Html rr Markdown    = to_html readMarkdown rr RST         = to_html readRST-rr HTML        = primHtml+rr HTML        = escape_html_unicode > primHtml rr Latex       = to_html readLaTeX  render_to_html = rr
src/Panda/Type/State.hs view
@@ -5,9 +5,10 @@ import Panda.Model.Tag import Random (randomRs, mkStdGen) import System.Time-import Control.Arrow ((>>>))+ import Panda.Helper.PreludeEnv import Data.Default+import Panda.Model.Post  data State = State   -- model state@@ -19,12 +20,13 @@   , nav_location :: String   , resource_title :: String   , human_test_data :: HumanTestData+  , latest_posts :: [Post]   }   deriving (Show) -show_left   = human_test_data >>> left >>> show-show_right  = human_test_data >>> right >>> show-show_op     = human_test_data >>> op >>> display_op+show_left   = human_test_data > left > show+show_right  = human_test_data > right > show+show_op     = human_test_data > op > display_op  read_op "+" = Plus read_op "-" = Minus@@ -48,7 +50,7 @@   def = Plus  instance Default State where-  def = State def def def def def def+  def = State def def def def def def def   ops = [Plus, Minus]@@ -65,6 +67,6 @@   where     make_sample [a,b,c] = ((get_num a), (get_num b), (get_op c))     make_sample _ = error "human test sample fail"-    good_test = splash3 simple_eval >>> belongs_to nums+    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
@@ -27,7 +27,7 @@   | Js   deriving (Eq, Show, Read) -to_theme xs = Theme +to_theme xs = Theme   { name        = at Name   , container   = at Container   , header      = at Header
src/Panda/View/Atom/Comment.hs view
@@ -7,7 +7,7 @@ import Panda.Type.State hiding (uid)  -- model-import Panda.Model.Comment hiding (create)+import Panda.Model.Comment  -- render instance DataRenderer Comment where
src/Panda/View/Control/Post.hs view
@@ -21,6 +21,7 @@ import Panda.View.Widget.Template  -- entry view+view :: State.State -> [Comment.Comment] -> Post -> Html view state xs x = (x.render_data +++ comment_view ).page state   where comment_view = only_for Comment $ CommentV.list xs +++ CommentV.create state (x.uid.Comment.from_post_id)
src/Panda/View/Widget/Template.hs view
@@ -29,6 +29,6 @@   , only_for Analytics $ primHtml (analytics G.analytics_account_id)   ] -template t state x = [html_head state, body t state x]+template t state x = [html_head state, body t state x] .toHtml  page = template G.theme