-- the controller is the most complex module for a reason: -- models are made as simple and small as possible -- views are pure functions. -- I believe this leads to more robust system, and provides much more -- flexibility in both design and implementation {-# 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 Config 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 -- 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 ) ] per_page = Config.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 Config.blog_id p tags nav blogs.map (Tag.fill_tag tags) .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 tags <- Tag.list.liftIO let state = State id Pager.empty tags no_navigation blog.Tag.fill_tag tags .PostV.view state .output_html static = do id <- uri static_page <- Static.get id .liftIO tags <- Tag.list.liftIO let nav = if title.belongs_to Config.navigation then title else no_navigation where title = static_page.Static.title 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