module Bamboo.Controller.Application where
import qualified Data.Map as Map
import Bamboo.Helper.Env hiding (tag, uri)
import Bamboo.Helper.StateHelper hiding (only_for)
import qualified Bamboo.Type.State as S
import qualified Bamboo.Config.Global as G
import qualified Bamboo.Type.Pager as Pager
import Bamboo.Type.Extension
import Hack
import Hack.Utils (not_found_app)
import qualified Bamboo.Model.Post as Post
import qualified Bamboo.Model.Static as Static
import qualified Bamboo.Model.Tag as Tag
import qualified Bamboo.Model.Comment as Comment
import qualified Bamboo.View.Control.Post as PostV
import qualified Bamboo.View.Control.Static as StaticV
import qualified Bamboo.View.Control.Tag as TagV
import qualified Bamboo.View.Control.Search as SearchV
import qualified Bamboo.View.Widget.RSS as RSSV
blog_regex = G.url_date_matcher
init_post tags x = x.Tag.fill_tag tags.Comment.fill_comment_size
tag_list = list
paths =
[ ("$" ,index )
, ("(\\?.+)?$" ,index )
, ("rss.xml$" ,index_feed )
, (blog_regex ,blog )
, ("static/." ,static )
, ("tag/.*/rss.xml$" ,tag_feed )
, ("tag/." ,tag )
, ("search" ,only_for Search $ search )
]
.map_fst ((G.root /) > ("^" ++))
only_for ext x = if has_extension ext then x else not_found_app
default_state = do
latest_posts <- Post.latest G.number_of_latest_posts
def { S.latest_posts = latest_posts } .return
index :: Application
index env = do
posts <- list
let p = posts.paginate env
tags <- tag_list
let nav = if p.Pager.current == 1 then home_nav else no_navigation
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 env = do
posts <- list
posts.RSSV.rss "" "" .output_html
blog env = do
let id = env .uri .Post.uri_to_id
blog <- get id
comments <- list_for id
tags <- tag_list
test_data <- S.mk_human_test
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 env = do
let id = env.uri
static_page <- get id
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
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 env = do
let id = env.uri
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 (get) >>= mapM (init_post tags)
let p = posts.paginate env
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 env = do
let id = env .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 get ^ map (Tag.fill_tag tags)
posts.RSSV.rss G.tag_id tag_name .output_html
search env = do
let s = env.param_with_default "s" ""
posts <- Post.search s
let p = posts.paginate env
tags <- tag_list
let query = env.uri
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