panda 2008.9.28 → 2008.9.29
raw patch · 45 files changed
+592/−396 lines, 45 files
Files
- Panda/Config/Global.hs +17/−6
- Panda/Controller/Application.hs +7/−7
- Panda/Helper/Env.hs +9/−1
- Panda/Helper/Helper.hs +11/−0
- Panda/Helper/MPSCandidate.hs +11/−0
- Panda/Model/Comment.hs +14/−10
- Panda/Model/Post.hs +3/−1
- Panda/Model/Static.hs +3/−1
- Panda/Model/Tag.hs +7/−7
- Panda/Type/Reader.hs +4/−1
- Panda/Type/Theme.hs +44/−0
- Panda/View/Atom/Comment.hs +49/−0
- Panda/View/Atom/Post.hs +30/−0
- Panda/View/Atom/Static.hs +7/−0
- Panda/View/Atom/Tag.hs +10/−0
- Panda/View/Control/Comment.hs +25/−0
- Panda/View/Control/Helper.hs +25/−0
- Panda/View/Control/Post.hs +24/−0
- Panda/View/Control/Search.hs +14/−0
- Panda/View/Control/Static.hs +7/−0
- Panda/View/Control/Tag.hs +15/−0
- Panda/View/RSS.hs +0/−35
- Panda/View/Theme/BluePrint/Comment.hs +0/−49
- Panda/View/Theme/BluePrint/Helper.hs +0/−25
- Panda/View/Theme/BluePrint/Post.hs +0/−43
- Panda/View/Theme/BluePrint/Search.hs +0/−14
- Panda/View/Theme/BluePrint/Static.hs +0/−7
- Panda/View/Theme/BluePrint/Tag.hs +0/−15
- Panda/View/Theme/BluePrint/Template/Body.hs +0/−57
- Panda/View/Theme/BluePrint/Template/Footer.hs +0/−19
- Panda/View/Theme/BluePrint/Template/Header.hs +0/−26
- Panda/View/Theme/BluePrint/Template/Sidebar.hs +0/−44
- Panda/View/Theme/BluePrint/Template/Template.hs +0/−6
- Panda/View/Widget/Body.hs +8/−0
- Panda/View/Widget/Footer.hs +17/−0
- Panda/View/Widget/Head.hs +12/−0
- Panda/View/Widget/Header.hs +18/−0
- Panda/View/Widget/Navigation.hs +19/−0
- Panda/View/Widget/RSS.hs +35/−0
- Panda/View/Widget/SearchBar.hs +5/−0
- Panda/View/Widget/Sidebar.hs +46/−0
- Panda/View/Widget/Template.hs +33/−0
- changelog.markdown +7/−0
- panda.cabal +33/−17
- readme.markdown +23/−5
Panda/Config/Global.hs view
@@ -4,6 +4,7 @@ import Prelude hiding ((.), (/), (^), id, readFile) import Panda.Type.Reader import Panda.Type.Sidebar+import Panda.Type.Theme db_id = "db" flat_id = "."@@ -12,6 +13,7 @@ tag_id = "tag" comment_id = "comment" sidebar_id = "sidebar"+theme_id = "theme" db_uri = db_id flat_uri = db_uri / flat_id@@ -21,17 +23,18 @@ blog_uri = flat_uri / blog_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 = readFile config_uri .purify .filter_comment .lines .map strip .map (split "\\s*=\\s*") .map tuple2+user_config' s = readFile s .purify .filter_comment .lines .map strip .map (split "\\s*=\\s*") .map tuple2+user_config = user_config' config_uri+ config_for' s d = user_config.lookup s .fromMaybe d config_for s = config_for' s s -parse_config s = s.split "," .map strip .reject null- blog_title = config_for "blog_title" blog_subtitle = config_for "blog_subtitle" host_name = config_for "host_name"@@ -47,9 +50,17 @@ sidebar = config_for "sidebar" .parse_config .map (sidebar_uri /).select (to_utf8 >>> doesFileExist >>> purify ) .map (read_sidebar_item default_reader >>> purify) -favicon = config_for "favicon"-+favicon = config_for' "favicon" "/favicon.ico" --- for extensions+-- 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 user_config' user_theme_uri .(("name", user_theme_name) : ) .to_theme+ else default_theme
Panda/Controller/Application.hs view
@@ -25,12 +25,12 @@ import qualified Panda.Model.Comment as Comment -- view-import qualified Panda.View.Theme.BluePrint.Post as PostV-import qualified Panda.View.Theme.BluePrint.Template.Template as T-import qualified Panda.View.Theme.BluePrint.Static as StaticV-import qualified Panda.View.Theme.BluePrint.Tag as TagV-import qualified Panda.View.Theme.BluePrint.Search as SearchV-import qualified Panda.View.RSS as RSSV+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 blog_regex = "^/[0-9][0-9]-[0-9][0-9]-[0-9][0-9]" @@ -131,7 +131,7 @@ if [checked, valid_path, exists].and then- inputs ^ to_h >>= (Comment.create >>> liftIO)+ inputs >>= (Comment.create >>> liftIO) else return () redirect $ ("/" ++ post_id.id_to_resource.to_utf8).urlEncode
Panda/Helper/Env.hs view
@@ -11,26 +11,34 @@ , module System.Locale , module System.Time.Parse , module Panda.Helper.Helper+ , module Panda.Helper.MPSCandidate , module Data.Maybe , module System.FilePath , module System.IO.UTF8 , module Text.XHtml.Strict , module System.Time , module System.Directory+ , module Data.Foldable+-- , module Data.Typeable+ , module Data.Generics ) where import MPS hiding (base, col, sub) import Control.Monad hiding (join) import Control.Arrow ((>>>), (&&&), (***))-import Data.List+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 Panda.Helper.MPSCandidate 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)+-- import Data.Typeable+import Data.Generics
Panda/Helper/Helper.hs view
@@ -22,6 +22,7 @@ import Data.List import Panda.Type.Reader import System.FilePath.Posix hiding ((<.>))+import Data.Generics (/) = (</>) infixl 5 /@@ -91,3 +92,13 @@ , s.show , "<![endif]-->" ] .join' .primHtml+++class Data a => DataRenderer a where+ render_data :: a -> Html++class Data a => FormRenderer a where+ render_form :: a -> Html++-- config+parse_config s = s.split "," .map strip .reject null
Panda/Helper/MPSCandidate.hs view
@@ -1,1 +1,12 @@ module Panda.Helper.MPSCandidate where+import MPS+import Prelude hiding ((.), (/), (^), id)+import Data.Typeable+import Data.Generics+import Text.XHtml.Strict++introspect a = zip fields (gmapQ gshow a)+ where fields = constrFields $ toConstr a++map_fields f x = map f (introspect x)+render_fields f x = map_fields f x .concatHtml
Panda/Model/Comment.hs view
@@ -1,56 +1,60 @@+{-# OPTIONS -XDeriveDataTypeable #-}+ module Panda.Model.Comment where -- env import Panda.Helper.Env hiding (match, title, body) import Prelude hiding ((.), (/), (^), id, readFile, writeFile) import qualified Panda.Config.Global as G-import qualified Data.Map as M import Panda.Type.Reader import qualified Panda.Model.Post as Post import System.Time import System.Directory data Comment = Comment- { uid :: String -- blog/08-09-04 blog title+ { uid :: String -- comment/08-09-04 blog title , author :: String , url :: String , body :: String }- deriving (Show, Eq)+ deriving (Show, Eq, Typeable, Data) list_for post_id = do has_comments <- doesDirectoryExist d if has_comments- then ls d ^ map from_utf8 ^ rsort ^ map (G.comment_id / r /) >>= mapM get+ then ls d ^ rsort ^ map (G.comment_id / r /) >>= mapM (from_utf8 >>> get) else return []- where + where d = (G.comment_uri / r) r = post_id.id_to_resource.to_utf8 +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.blog_id / x.split "/" .last+ get id = do- xs <- (G.flat_uri / id) .readFile ^ lines+ xs <- (G.flat_uri / id.to_utf8) .readFile ^ lines let author = xs.first let url = xs.drop 2.first let body = xs.drop 4.unlines return $ Comment id author url body - create h = do let author = at "author" let url = at "url" let body = at "comment"- let post_id = at "post_id" + let post_id = at "post_id" timestamp <- ( getClockTime >>= toCalendarTime ) ^ format_date- let comment_path = G.flat_uri / G.comment_id / (post_id.split "/".last.to_utf8) + let comment_path = post_id_to_uid post_id .to_utf8 createDirectoryIfMissing True comment_path let uid = comment_path / timestamp let content = [author, url, body].join "\n\n" writeFile uid content - where at s = h.M.lookup s .fromJust+ where at s = h.lookup s .fromJust format_date x = formatCalendarTime defaultTimeLocale "%y-%m-%d %T" x parse_date = parseCalendarTime defaultTimeLocale "%Y-%m-%d %T"
Panda/Model/Post.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS -XDeriveDataTypeable #-}+ -- 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@@ -18,7 +20,7 @@ , comment_size :: Int , reader :: Reader }- deriving (Show, Eq)+ deriving (Show, Eq, Typeable, Data) list = ls G.blog_uri ^ map from_utf8 ^ rsort ^ map (G.blog_id /) >>= mapM get
Panda/Model/Static.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS -XDeriveDataTypeable #-}+ module Panda.Model.Static where -- env@@ -11,7 +13,7 @@ , body :: String , reader :: Reader }- deriving (Show, Eq)+ deriving (Show, Eq, Typeable, Data) get id = liftM2 (Static id) (get_body id) (return $ get_reader id)
Panda/Model/Tag.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS -XDeriveDataTypeable #-}+ module Panda.Model.Tag where import qualified Panda.Model.Post as Post@@ -5,20 +7,18 @@ -- env import Panda.Helper.Env hiding (name) import Prelude hiding ((.), (/), (^), id, readFile)-import qualified Data.Set as Set-import qualified Data.Map as Map-import qualified Data.List as List+import qualified Data.Set as S import qualified Panda.Config.Global as G data Tag = Tag { uid :: String -- tag/name , name :: String- , resources :: Set.Set String+ , resources :: S.Set String }- deriving (Show, Eq)+ deriving (Show, Eq, Typeable, Data) -sorted xs = xs.List.sortBy(compare_by (resources >>> Set.size)).reverse+sorted xs = xs.sortBy(compare_by (resources >>> S.size)).reverse name_to_id x = G.tag_id / x list = ls G.tag_uri ^ map from_utf8 ^ map (G.tag_id /) >>= mapM get@@ -32,5 +32,5 @@ tag_map' xs = xs . map (name &&& resources) . to_h tag_map = list ^ tag_map' -for_resource xs x = xs.select (resources >>> Set.member 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) }
Panda/Type/Reader.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS -XDeriveDataTypeable #-}+ module Panda.Type.Reader where import MPS @@ -6,8 +8,9 @@ import Text.Pandoc import Control.Arrow ((>>>)) import Text.XHtml.Strict+import Data.Generics -data Reader = Markdown | RST | HTML | Latex deriving (Show, Eq)+data Reader = Markdown | RST | HTML | Latex deriving (Show, Eq, Typeable, Data) readers = [ (Markdown, ["markdown", "md"])
+ 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_config.map (\x -> "/theme/" ++ at "name" ++ "/css/" ++ x ++ ".css")+ js_list s = s.parse_config.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 view
@@ -0,0 +1,49 @@+module Panda.View.Atom.Comment where+ +import Panda.Helper.Env hiding (title, date)+import Prelude hiding ((.), (/), (^), id, span)++-- 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 + [ cite << a+ , toHtml " says:"+ , br+ , p ! [theclass "small"] << comment_date x+ , x.markup+ ]+ where a = if x.url.null then x.author.toHtml else toHtml $ hotlink (x.url) << x.author++comment_date x = toHtml $ x.date.formatCalendarTime defaultTimeLocale "%b %e, %Y at %I:%M %p"+++-- form+instance FormRenderer Comment where+ render_form = create++create x = toHtml+ [ h2 ! [id "respond"] << "Leave a Response"+ , gui "/comment/create" ! [id "commentform"] <<+ [ field "author" 22 1 "Name (required)"+ , field "url" 22 2 "Website"+ , field "human-hack" 22 3 "What is 5 + 5 ?"+ , p << hidden "post_id" (x.uid.uid_to_post_id)+ , p << textarea ! [name "comment", id "comment", cols "10", rows "20", strAttr "tabindex" "4"] << ""+ , p << submit "submit" "Submit Comment" ! [strAttr "tabindex" "5"]+ ]+ ]+++field x s t m = p <<+ [ label ! [thefor x] << small << m+ , br + , textfield x ! [size (s.show), strAttr "tabindex" (t.show)]+ ]
+ Panda/View/Atom/Post.hs view
@@ -0,0 +1,30 @@+module Panda.View.Atom.Post where+ +import Panda.Helper.Env hiding (name, title, date)+import Prelude hiding ((.), (/), (^), id, span)++-- view+import qualified Panda.View.Atom.Tag as Tag++-- model+import Panda.Model.Post++-- render+instance DataRenderer Post where+ render_data = entry++-- instance helpers+entry x = div_class "post" << [entry_title, entry_mark, entry_body] where+ entry_title = x.title_link+ entry_body = div_class "entry" << x.markup+ entry_mark = p ! [theclass "small"] << [ blog_date, blog_tags, blog_comments ].map (send_to x)++title_link x = h2 << hotlink (entry_uri x) << x.title+entry_uri x = "/" ++ uid x .id_to_resource+blog_date x = toHtml $ x.date.formatCalendarTime defaultTimeLocale "%b %e, %Y"++blog_tags x | x.tags.null = toHtml ""+blog_tags x = " | " +++ "Published in " +++ x.tags.map Tag.tag_link .intersperse (", ".toHtml)++blog_comments x | x.comment_size.is 0 = toHtml ""+blog_comments x = " | " +++ hotlink (entry_uri x / "#comments") << (x.comment_size.show ++ " Comments")
+ 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
+ Panda/View/Atom/Tag.hs view
@@ -0,0 +1,10 @@+module Panda.View.Atom.Tag where+ +import Panda.Helper.Env hiding (name)+import Panda.Model.Tag++instance DataRenderer Tag where+ render_data = name >>> tag_link++tag_link s = toHtml $ hotlink ("/tag/" ++ s ) << s +
+ 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
+ Panda/View/Control/Helper.hs view
@@ -0,0 +1,25 @@+module Panda.View.Control.Helper where++import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+ +import Panda.Type.Pager as Pager+++nav p r = + [ div_class "alighleft" << nav_next p r+ , div_class "alignright" << nav_previous 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 view
@@ -0,0 +1,24 @@+module Panda.View.Control.Post where++-- env+import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)++import qualified Panda.Type.State as State++-- 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 (x.uid.Comment.from_post_id) ).page state++-- list view+list state = for_current_page p >>> map render_data >>> (+++ nav p "/") >>> page state+ where p = state.State.pager
+ Panda/View/Control/Search.hs view
@@ -0,0 +1,14 @@+module Panda.View.Control.Search where+ +import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Type.State as State++-- 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 ("/search" ++ "?s=" ++ s ++ "&")) >>> page state+ where p = state.State.pager+
+ 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
+ Panda/View/Control/Tag.hs view
@@ -0,0 +1,15 @@+module Panda.View.Control.Tag where+ +import Panda.Helper.Env+import Prelude hiding ((.), (/), (^), id, span)+import qualified Panda.Type.State as State++-- view+import Panda.View.Atom.Post+import Panda.View.Control.Helper+import Panda.View.Widget.Template++view state = for_current_page p >>> map render_data >>> (+++ nav p ("/" ++ tag_id)) >>> page state+ where p = state.State.pager+ tag_id = state.State.uid+
− Panda/View/RSS.hs
@@ -1,35 +0,0 @@-module Panda.View.RSS where---- env-import Panda.Helper.Env -- hiding (Language)-import Prelude hiding ((.), (/), (^), id)-import qualified Panda.Config.Global as G-import Panda.Type.Pager as Pager-import Text.RSS---- model-import Panda.Model.Post as Post---entry_uri x = "/" ++ Post.uid x.split "/".tail.join "/"---- RSS-channel_rss_template = [ Language "en-us" ]--item_rss_template x = - [ Title $ x.Post.title- , Description $ x.Post.markup.show- , Author $ G.author_email- , Link $ x.item_uri- , PubDate $ x.Post.date - ]--item_uri x = nullURI { uriScheme = "http://", uriPath = G.host_name ++ x.entry_uri }-rss_uri x = nullURI { uriScheme = "http://", uriPath = x / "rss.xml" }--rss categary s xs = RSS title (rss_uri link) title channel_rss_template (xs.take 20 .map item_rss_template)- .rssToXML.showXML- where - link = G.host_name / categary / s- title = G.blog_title ++ " / " ++ s-
− Panda/View/Theme/BluePrint/Comment.hs
@@ -1,49 +0,0 @@-module Panda.View.Theme.BluePrint.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-import qualified Panda.Model.Post as Post---- view-import Panda.View.Theme.BluePrint.Helper-import Panda.View.Theme.BluePrint.Template.Template---list [] = []-list xs = - [ h2 ! [id "comments"] << "Responses"- , olist ! [theclass "commentlist" ] << xs.zip (cycle ["comments-alt", ""]).map (splash entry)- ]--entry alt x = li ! [theclass alt] << - [ cite << a- , toHtml " says:"- , br- , p ! [theclass "small"] << comment_date x- , x.markup- ]- where a = if x.url.null then x.author.toHtml else toHtml $ hotlink (x.url) << x.author--comment_date x = toHtml $ x.date.formatCalendarTime defaultTimeLocale "%b %e, %Y at %I:%M %p"---- create = spaceHtml-create post = - [ h2 ! [id "respond"] << "Leave a Response"- , gui "/comment/create" ! [id "commentform"] <<- [ field "author" 22 1 "Name (required)"- , field "url" 22 2 "Website"- , field "human-hack" 22 3 "What is 5 + 5 ?"- , p << hidden "post_id" (post.Post.uid)- , p << textarea ! [name "comment", id "comment", cols "10", rows "20", strAttr "tabindex" "4"] << ""- , p << submit "submit" "Submit Comment" ! [strAttr "tabindex" "5"]- ]- ]- -field x s t m = p <<- [ label ! [thefor x] << small << m- , br - , textfield x ! [size (s.show), strAttr "tabindex" (t.show)]- ]
− Panda/View/Theme/BluePrint/Helper.hs
@@ -1,25 +0,0 @@-module Panda.View.Theme.BluePrint.Helper where--import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)- -import Panda.Type.Pager as Pager---nav p r = - [ div_class "alighleft" << nav_next p r- , div_class "alignright" << nav_previous 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/Theme/BluePrint/Post.hs
@@ -1,43 +0,0 @@-module Panda.View.Theme.BluePrint.Post where---- env-import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)--import qualified Panda.Type.State as State---- model-import Panda.Model.Post as Post-import qualified Panda.Model.Comment as Comment---- view-import Panda.View.Theme.BluePrint.Helper-import qualified Panda.View.Theme.BluePrint.Comment as CommentV-import Panda.View.Theme.BluePrint.Template.Template---- HTML--- render single entry-entry x = div_class "post" << [entry_title, entry_mark, entry_body] where- entry_title = x.title_link- entry_body = div_class "entry" << x.Post.markup- entry_mark = p ! [theclass "small"] << [ blog_date, blog_tags, blog_comments ].map (send_to x)--title_link x = h2 << hotlink (entry_uri x) << x.Post.title-entry_uri x = "/" ++ Post.uid x .id_to_resource-blog_date x = toHtml $ x.Post.date.formatCalendarTime defaultTimeLocale "%b %e, %Y"--blog_tags x | x.tags.null = toHtml ""-blog_tags x = " | " +++ "Published in " +++ x.tags.map tag_link .intersperse (", ".toHtml)--blog_comments x | x.comment_size.is 0 = toHtml ""-blog_comments x = " | " +++ hotlink (entry_uri x / "#comments") << (x.comment_size.show ++ " Comments")--tag_link s = toHtml $ hotlink ("/tag/" ++ s ) << s----- entry view-view state xs x = (x.entry +++ CommentV.list xs +++ CommentV.create x).page state---- list view-list state = for_current_page p >>> map entry >>> (+++ nav p "/") >>> page state- where p = state.State.pager
− Panda/View/Theme/BluePrint/Search.hs
@@ -1,14 +0,0 @@-module Panda.View.Theme.BluePrint.Search where- -import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Type.State as State---- view-import Panda.View.Theme.BluePrint.Post hiding (view)-import Panda.View.Theme.BluePrint.Helper-import Panda.View.Theme.BluePrint.Template.Template--view state s = for_current_page p >>> map entry >>> (+++ nav p ("/search" ++ "?s=" ++ s ++ "&")) >>> page state- where p = state.State.pager-
− Panda/View/Theme/BluePrint/Static.hs
@@ -1,7 +0,0 @@-module Panda.View.Theme.BluePrint.Static where- -import Panda.Helper.Env-import Panda.Model.Static as Static-import Panda.View.Theme.BluePrint.Template.Template--view state = Static.markup >>> page state
− Panda/View/Theme/BluePrint/Tag.hs
@@ -1,15 +0,0 @@-module Panda.View.Theme.BluePrint.Tag where- -import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Type.State as State---- view-import Panda.View.Theme.BluePrint.Post hiding (view)-import Panda.View.Theme.BluePrint.Helper-import Panda.View.Theme.BluePrint.Template.Template--view state = for_current_page p >>> map entry >>> (+++ nav p ("/" ++ tag_id)) >>> page state- where p = state.State.pager- tag_id = state.State.uid-
− Panda/View/Theme/BluePrint/Template/Body.hs
@@ -1,57 +0,0 @@-module Panda.View.Theme.BluePrint.Template.Body where---- env-import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G-import qualified Panda.Type.State as State---- view-import Panda.View.Theme.BluePrint.Template.Sidebar-import Panda.View.Theme.BluePrint.Template.Footer---- extension-import Panda.Extension.Analytics.T---html_body state x = body << - [ div_class "container" << - [ body_header state- , div_id "page" << [ body_content x, html_sidebar state ]- , html_footer- ]- , primHtml analytics_snippet- ]--body_header state = toHtml- [ div_class_id "column span-12 first" "header" << - [ search_form- , site_name- ]- , div_class_id "column span-12 first large" "nav" << navigation state- ]---- search_form = spaceHtml-search_form = div_id "search" << form ! [action "/search", method "get"] << thediv << textfield "s"- -site_name = toHtml $- [ toHtml $ hotlink "/" ! [theclass "logo"] << ""- , h1 << G.blog_title- , div_class "description" << G.blog_subtitle- ]--navigation state = 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 "/" << home_nav-static_link s = hotlink ("/" / "static" / s) << s.dropExtension---body_content x = div_class_id "column span-9 first" "maincontent" <<- div_class "content" << x-
@@ -1,19 +0,0 @@-module Panda.View.Theme.BluePrint.Template.Footer where- -import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G---import qualified Panda.Config.Global as G--html_footer = div_id "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/Theme/BluePrint/Template/Header.hs
@@ -1,26 +0,0 @@-module Panda.View.Theme.BluePrint.Template.Header where--import Panda.Helper.Env-import Prelude hiding ((.), (/), (^), id, span)-import qualified Panda.Config.Global as G---html_head = header << ([meta_tag, title_tag, favicon_tag, rss_tag] ++ css_list ++ js_list )--title_tag = thetitle << G.blog_title-rss_tag = rss_link "rss.xml"-favicon_tag = favicon_link G.favicon---- css-css_list = [screen_css, wp_css, custom_css]-screen_css = css_link "/theme/blueprint/wp/css/screen.css"-wp_css = css_link "/theme/blueprint/wp/css/blueprint-wp.css"-custom_css = css_link "/theme/blueprint/wp/css/custom.css"----- js-js_list = [jquery_js, jquery_param, jquery_highlight, custom_js]-jquery_js = js_link "/js/lib/jquery/jquery-1.2.6.min.js"-jquery_param = js_link "/js/lib/jquery/jquery.getUrlParam.js"-jquery_highlight = js_link "/js/lib/jquery/jquery.highlight-2.js"-custom_js = js_link "/js/custom.js"
− Panda/View/Theme/BluePrint/Template/Sidebar.hs
@@ -1,44 +0,0 @@-module Panda.View.Theme.BluePrint.Template.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---- model-import Panda.Model.Tag as Tag--html_sidebar state = - div_class_id "column span-3 last" "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.Sidebar.markup)- formatted_list = (stock_list ++ custom_list) .intersperse hr--feed state = toHtml- [ h2 << "Subscribe"- , p ! [theclass "feed"] << rss_link state- ]--rss_link state = - if tagged - then- let tag_name = Tag.get_name uid in- link ("tag" / tag_name) tag_name- else link "" "Home"- where- uid = State.uid state- tagged = uid.match "^tag/.+" .isJust- link r s = hotlink ("/" / r / "rss.xml") ! [ theclass "feedlink" ] << s--tag_list tags = toHtml- [ h2 << "Tags"- , unordList $ tags.Tag.sorted.map tag_link]- -tag_link x = ( hotlink ("/" ++ x.uid) << x.Tag.name ) +++ ( " (" ++ x.Tag.resources.Set.size.show ++ ")" )
− Panda/View/Theme/BluePrint/Template/Template.hs
@@ -1,6 +0,0 @@-module Panda.View.Theme.BluePrint.Template.Template where--import Panda.View.Theme.BluePrint.Template.Header-import Panda.View.Theme.BluePrint.Template.Body--page state x = [html_head, html_body state x]
+ 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+
@@ -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"+ ]
+ Panda/View/Widget/Head.hs view
@@ -0,0 +1,12 @@+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)++html_head = header << ([meta_tag, title_tag, favicon_tag, rss_tag] ++ G.theme.css.map css_link ++ G.theme.js.map js_link )++title_tag = thetitle << G.blog_title+rss_tag = rss_link "rss.xml"+favicon_tag = favicon_link G.favicon
+ 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 "/" ! [theclass "logo"] << ""+ , h1 << G.blog_title+ , div_class "description" << G.blog_subtitle+ ]
@@ -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 "/" << home_nav+static_link s = hotlink ("/" / "static" / s) << s.dropExtension
+ Panda/View/Widget/RSS.hs view
@@ -0,0 +1,35 @@+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 Panda.Type.Pager as Pager+import Text.RSS++-- model+import Panda.Model.Post as Post+++entry_uri x = "/" ++ Post.uid x.split "/".tail.join "/"++-- RSS+channel_rss_template = [ Language "en-us" ]++item_rss_template x = + [ Title $ x.Post.title+ , Description $ x.Post.markup.show+ , Author $ G.author_email+ , Link $ x.item_uri+ , PubDate $ x.Post.date + ]++item_uri x = nullURI { uriScheme = "http://", uriPath = G.host_name ++ x.entry_uri }+rss_uri x = nullURI { uriScheme = "http://", uriPath = x / "rss.xml" }++rss categary s xs = RSS title (rss_uri link) title channel_rss_template (xs.take 20 .map item_rss_template)+ .rssToXML.showXML+ where + link = G.host_name / categary / s+ title = G.blog_title ++ " / " ++ s+
+ Panda/View/Widget/SearchBar.hs view
@@ -0,0 +1,5 @@+module Panda.View.Widget.SearchBar where+ +import Panda.Helper.Env hiding (header)++search_bar = div_id "search" << form ! [action "/search", method "get"] << thediv << textfield "s"
+ Panda/View/Widget/Sidebar.hs view
@@ -0,0 +1,46 @@+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++-- 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.Sidebar.markup)+ formatted_list = (stock_list ++ custom_list) .intersperse hr++feed state = toHtml+ [ h2 << "Subscribe"+ , p ! [theclass "feed"] << rss_link state+ ]++rss_link state = + if tagged + then+ let tag_name = Tag.get_name uid in+ link ("tag" / tag_name) tag_name+ else link "" "Home"+ where+ uid = State.uid state+ tagged = uid.match "^tag/.+" .isJust+ link r s = hotlink ("/" / r / "rss.xml") ! [ theclass "feedlink" ] << s++tag_list tags = toHtml+ [ h2 << "Tags"+ , unordList $ tags.Tag.sorted.map tag_link]+ +tag_link x = ( hotlink ("/" ++ x.Tag.uid) << x.Tag.name ) +++ ( " (" ++ x.Tag.resources.Set.size.show ++ ")" )
+ Panda/View/Widget/Template.hs view
@@ -0,0 +1,33 @@+{-# 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, body t state x]++page = template G.theme
changelog.markdown view
@@ -1,3 +1,10 @@+2008.9.29+---------++### Features++* Text based theme+ 2008.9.28 ---------
panda.cabal view
@@ -1,5 +1,5 @@ Name: panda-Version: 2008.9.28+Version: 2008.9.29 Build-type: Simple Synopsis: Simple Static Blog Engine Description: Simple Static Blog Engine@@ -17,31 +17,47 @@ build-depends: base, cgi <= 3001.1.6.0, network, haskell98, old-locale, old-time, directory, filepath, containers, mps >= 2008.9.19, parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, kibro == 0.0, utf8-string >= 0.3.1, pandoc >= 0.46, MissingH, parsec >= 2 exposed-modules: Panda Panda.Config.Global+ Panda.Controller.Application++ Panda.Extension.Analytics.T+ Panda.Helper.Env- Panda.Helper.MPSCandidate Panda.Helper.Helper+ Panda.Helper.MPSCandidate++ Panda.Model.Comment Panda.Model.Post Panda.Model.Static Panda.Model.Tag- Panda.Model.Comment+ Panda.Type.Pager Panda.Type.Reader- Panda.Type.State Panda.Type.Sidebar- Panda.View.RSS- Panda.View.Theme.BluePrint.Helper- Panda.View.Theme.BluePrint.Post- Panda.View.Theme.BluePrint.Search- Panda.View.Theme.BluePrint.Static- Panda.View.Theme.BluePrint.Tag- Panda.View.Theme.BluePrint.Comment- Panda.View.Theme.BluePrint.Template.Body- Panda.View.Theme.BluePrint.Template.Footer- Panda.View.Theme.BluePrint.Template.Header- Panda.View.Theme.BluePrint.Template.Sidebar- Panda.View.Theme.BluePrint.Template.Template- Panda.Extension.Analytics.T+ Panda.Type.State+ Panda.Type.Theme+ + Panda.View.Atom.Comment+ Panda.View.Atom.Post+ Panda.View.Atom.Static+ Panda.View.Atom.Tag+ + Panda.View.Control.Comment+ Panda.View.Control.Helper+ Panda.View.Control.Post+ Panda.View.Control.Search+ Panda.View.Control.Static+ Panda.View.Control.Tag+ + Panda.View.Widget.Body+ Panda.View.Widget.Footer+ Panda.View.Widget.Head+ Panda.View.Widget.Header+ Panda.View.Widget.Navigation+ Panda.View.Widget.RSS+ Panda.View.Widget.SearchBar+ Panda.View.Widget.Sidebar+ Panda.View.Widget.Template
readme.markdown view
@@ -82,11 +82,30 @@ Restart required. (hint: `rake r`) -Future-------+Theme+-------- -There are many things could be done. Whatever there will be, the key idea is simplest data / folder structure.+Example blueprint theme in `db/config/theme/blueprint.txt` + container = container+ header = column span-12 first+ navigation = column span-12 first large+ main = column span-9 first+ sidebar = column span-3 last+ footer = footer++ css = screen, blueprint-wp, custom+ js = jquery-1.2.6.min, jquery.getUrlParam, jquery.highlight-2, custom+++note: `css` and `js` are required to be placed under `db/public/theme/your_theme_name/css` and `db/public/theme/your_theme_name/js`, leave out the file extensions too, since the engine will fill it for you.++You can create new themes by adding theme files in `db/config/theme`, and place++ theme = your_new_theme++inside `site.txt`.+ Hacking -------- @@ -114,5 +133,4 @@ and so on. -If the latest git version doesn't build, try `cabal install cgi`; if still no good, try `cabal update; cabal upgrade` to upgrade haskell packages.- +If the latest git version doesn't build, try `ghc-pkg unregister cgi-3001.1.7.0 --user`.