-- the controller is the most complex module for a reason: -- models are made as simple and small as possible -- views are pure functions. -- a note on encoding: -- IO are in utf-8 filter, internally use bytes {-# OPTIONS -fno-monomorphism-restriction #-} module Panda.Controller.Application where import qualified Data.Map as Map -- env import Panda.Helper.Env hiding (tag) import Prelude hiding ((.), (/), (^), id) import Panda.Type.State hiding (pager) import qualified Panda.Config.Global as G import qualified Panda.Type.Pager as Pager -- model import qualified Panda.Model.Post as Post import qualified Panda.Model.Static as Static import qualified Panda.Model.Tag as Tag import qualified Panda.Model.Comment as Comment -- view import qualified Panda.View.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 blog_regex = "^/[0-9][0-9]-[0-9][0-9]-[0-9][0-9]" pages = [ ("^/$" ,index ) , ("^/([?].+$)?$" ,index ) , ("^/rss.xml$" ,index_feed ) , (blog_regex ,blog ) , ("^/static/." ,static ) , ("^/tag/.*/rss.xml$" ,tag_feed ) , ("^/tag/." ,tag ) , ("^/search" ,search ) , ("^/comment/create" ,comment_create ) ] per_page = G.per_page index = do blogs <- Post.list.liftIO p <- pager per_page $ blogs.length tags <- Tag.list.liftIO let nav = if p.Pager.current == 1 then home_nav else no_navigation let state = State G.blog_id p tags nav blogs.map (Tag.fill_tag tags).mapM ( Comment.fill_comment_size >>> liftIO ) ^ PostV.list state >>= output_html index_feed = do blogs <- Post.list.liftIO blogs.RSSV.rss "" "" .output blog = do id <- uri ^ ("blog/" ++) blog <- Post.get id .liftIO comments <- Comment.list_for id .liftIO tags <- Tag.list.liftIO let state = State id Pager.empty tags no_navigation blog.Tag.fill_tag tags .Comment.fill_comment_size .liftIO ^ PostV.view state comments >>= output_html static = do id <- uri static_page <- Static.get id .liftIO tags <- Tag.list.liftIO 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 = State id Pager.empty tags nav StaticV.view state static_page .output_html tag = do id <- uri tags <- Tag.list.liftIO let tag_name = Tag.get_name id case Tag.tag_map' tags .Map.lookup tag_name of Nothing -> "page not found" .output Just blog_set -> do blogs <- blog_set.to_list.rsort.mapM (Post.get) .liftIO ^ map (Tag.fill_tag tags) p <- pager per_page $ blogs.length let state = State id p tags no_navigation blogs.TagV.view state.output_html tag_feed = do id <- uri ^ (split "/" >>> init >>> join "/") tags <- Tag.list.liftIO let tag_name = Tag.get_name id case Tag.tag_map' tags .Map.lookup tag_name of Nothing -> "page not found" .output Just blog_set -> do blogs <- blog_set.to_list.rsort.mapM (Post.get) .liftIO ^ map (Tag.fill_tag tags) blogs.RSSV.rss "tag" tag_name.output search = do s <- param_with_default "s" "" blogs <- Post.search s .liftIO p <- pager per_page $ blogs.length tags <- Tag.list.liftIO query <- uri let state = State query p tags no_navigation blogs.map (Tag.fill_tag tags) .SearchV.view state s.output_html comment_create = do post_id <- input_with_default "post_id" (G.blog_id / "nothing") exists <- (G.flat_uri / post_id.to_utf8) .doesFileExist .liftIO let valid_path = equalFilePath G.blog_id (takeDirectory post_id) checked <- check_create if [checked, valid_path, exists].and then inputs ^ to_h >>= (Comment.create >>> liftIO) else return () redirect $ ("/" ++ post_id.id_to_resource.to_utf8).urlEncode -- create helper, should be refactored to some common aspect check_create = [ validate "author" ( length >>> (> 0)) , validate "url" (const True) , validate "comment" ( length >>> (> 0)) , validate "human-hack" (is "10") ] .sequence ^ and validate s f = do maybe_s <- get_input s case maybe_s of Nothing -> return False Just v -> return $ f v