diff --git a/Panda/Config/Global.hs b/Panda/Config/Global.hs --- a/Panda/Config/Global.hs +++ b/Panda/Config/Global.hs @@ -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 diff --git a/Panda/Controller/Application.hs b/Panda/Controller/Application.hs --- a/Panda/Controller/Application.hs +++ b/Panda/Controller/Application.hs @@ -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 diff --git a/Panda/Helper/Env.hs b/Panda/Helper/Env.hs --- a/Panda/Helper/Env.hs +++ b/Panda/Helper/Env.hs @@ -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 diff --git a/Panda/Helper/Helper.hs b/Panda/Helper/Helper.hs --- a/Panda/Helper/Helper.hs +++ b/Panda/Helper/Helper.hs @@ -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 , "" ] .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 diff --git a/Panda/Helper/MPSCandidate.hs b/Panda/Helper/MPSCandidate.hs --- a/Panda/Helper/MPSCandidate.hs +++ b/Panda/Helper/MPSCandidate.hs @@ -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 diff --git a/Panda/Model/Comment.hs b/Panda/Model/Comment.hs --- a/Panda/Model/Comment.hs +++ b/Panda/Model/Comment.hs @@ -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" diff --git a/Panda/Model/Post.hs b/Panda/Model/Post.hs --- a/Panda/Model/Post.hs +++ b/Panda/Model/Post.hs @@ -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 diff --git a/Panda/Model/Static.hs b/Panda/Model/Static.hs --- a/Panda/Model/Static.hs +++ b/Panda/Model/Static.hs @@ -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) diff --git a/Panda/Model/Tag.hs b/Panda/Model/Tag.hs --- a/Panda/Model/Tag.hs +++ b/Panda/Model/Tag.hs @@ -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) } diff --git a/Panda/Type/Reader.hs b/Panda/Type/Reader.hs --- a/Panda/Type/Reader.hs +++ b/Panda/Type/Reader.hs @@ -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"]) diff --git a/Panda/Type/Theme.hs b/Panda/Type/Theme.hs new file mode 100644 --- /dev/null +++ b/Panda/Type/Theme.hs @@ -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 = [""] + } diff --git a/Panda/View/Atom/Comment.hs b/Panda/View/Atom/Comment.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Atom/Comment.hs @@ -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)] + ] diff --git a/Panda/View/Atom/Post.hs b/Panda/View/Atom/Post.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Atom/Post.hs @@ -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") diff --git a/Panda/View/Atom/Static.hs b/Panda/View/Atom/Static.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Atom/Static.hs @@ -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 diff --git a/Panda/View/Atom/Tag.hs b/Panda/View/Atom/Tag.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Atom/Tag.hs @@ -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 + diff --git a/Panda/View/Control/Comment.hs b/Panda/View/Control/Comment.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Control/Comment.hs @@ -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 diff --git a/Panda/View/Control/Helper.hs b/Panda/View/Control/Helper.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Control/Helper.hs @@ -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" diff --git a/Panda/View/Control/Post.hs b/Panda/View/Control/Post.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Control/Post.hs @@ -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 diff --git a/Panda/View/Control/Search.hs b/Panda/View/Control/Search.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Control/Search.hs @@ -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 + diff --git a/Panda/View/Control/Static.hs b/Panda/View/Control/Static.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Control/Static.hs @@ -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 diff --git a/Panda/View/Control/Tag.hs b/Panda/View/Control/Tag.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Control/Tag.hs @@ -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 + diff --git a/Panda/View/RSS.hs b/Panda/View/RSS.hs deleted file mode 100644 --- a/Panda/View/RSS.hs +++ /dev/null @@ -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 - diff --git a/Panda/View/Theme/BluePrint/Comment.hs b/Panda/View/Theme/BluePrint/Comment.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Comment.hs +++ /dev/null @@ -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)] - ] diff --git a/Panda/View/Theme/BluePrint/Helper.hs b/Panda/View/Theme/BluePrint/Helper.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Helper.hs +++ /dev/null @@ -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" diff --git a/Panda/View/Theme/BluePrint/Post.hs b/Panda/View/Theme/BluePrint/Post.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Post.hs +++ /dev/null @@ -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 diff --git a/Panda/View/Theme/BluePrint/Search.hs b/Panda/View/Theme/BluePrint/Search.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Search.hs +++ /dev/null @@ -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 - diff --git a/Panda/View/Theme/BluePrint/Static.hs b/Panda/View/Theme/BluePrint/Static.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Static.hs +++ /dev/null @@ -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 diff --git a/Panda/View/Theme/BluePrint/Tag.hs b/Panda/View/Theme/BluePrint/Tag.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Tag.hs +++ /dev/null @@ -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 - diff --git a/Panda/View/Theme/BluePrint/Template/Body.hs b/Panda/View/Theme/BluePrint/Template/Body.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Template/Body.hs +++ /dev/null @@ -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 - diff --git a/Panda/View/Theme/BluePrint/Template/Footer.hs b/Panda/View/Theme/BluePrint/Template/Footer.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Template/Footer.hs +++ /dev/null @@ -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" - ] diff --git a/Panda/View/Theme/BluePrint/Template/Header.hs b/Panda/View/Theme/BluePrint/Template/Header.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Template/Header.hs +++ /dev/null @@ -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" diff --git a/Panda/View/Theme/BluePrint/Template/Sidebar.hs b/Panda/View/Theme/BluePrint/Template/Sidebar.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Template/Sidebar.hs +++ /dev/null @@ -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 ++ ")" ) diff --git a/Panda/View/Theme/BluePrint/Template/Template.hs b/Panda/View/Theme/BluePrint/Template/Template.hs deleted file mode 100644 --- a/Panda/View/Theme/BluePrint/Template/Template.hs +++ /dev/null @@ -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] diff --git a/Panda/View/Widget/Body.hs b/Panda/View/Widget/Body.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/Body.hs @@ -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 + diff --git a/Panda/View/Widget/Footer.hs b/Panda/View/Widget/Footer.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/Footer.hs @@ -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" + ] diff --git a/Panda/View/Widget/Head.hs b/Panda/View/Widget/Head.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/Head.hs @@ -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 diff --git a/Panda/View/Widget/Header.hs b/Panda/View/Widget/Header.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/Header.hs @@ -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 + ] diff --git a/Panda/View/Widget/Navigation.hs b/Panda/View/Widget/Navigation.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/Navigation.hs @@ -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 diff --git a/Panda/View/Widget/RSS.hs b/Panda/View/Widget/RSS.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/RSS.hs @@ -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 + diff --git a/Panda/View/Widget/SearchBar.hs b/Panda/View/Widget/SearchBar.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/SearchBar.hs @@ -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" diff --git a/Panda/View/Widget/Sidebar.hs b/Panda/View/Widget/Sidebar.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/Sidebar.hs @@ -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 ++ ")" ) diff --git a/Panda/View/Widget/Template.hs b/Panda/View/Widget/Template.hs new file mode 100644 --- /dev/null +++ b/Panda/View/Widget/Template.hs @@ -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 diff --git a/changelog.markdown b/changelog.markdown --- a/changelog.markdown +++ b/changelog.markdown @@ -1,3 +1,10 @@ +2008.9.29 +--------- + +### Features + +* Text based theme + 2008.9.28 --------- diff --git a/panda.cabal b/panda.cabal --- a/panda.cabal +++ b/panda.cabal @@ -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 diff --git a/readme.markdown b/readme.markdown --- a/readme.markdown +++ b/readme.markdown @@ -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`.