{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NamedFieldPuns #-} module Bamboo.Controller.Tag where import Bamboo.Controller.Env import qualified Bamboo.Model.Tag as Tag import qualified Bamboo.Type.State as S import qualified Bamboo.Type as T import qualified Bamboo.View.Control.Tag as TagV import qualified Bamboo.View.Widget.RSS as RSSV import qualified Data.Map as Map tag_controller :: Controller tag_controller = do init_state s <- get let uid = s.env.uri tag_name = Tag.get_name uid case Tag.tag_map' (s.tags) .Map.lookup tag_name of Nothing -> not_found Just post_set -> do posts' <- post_set.to_list.rsort.mapM (to_us > T.get > io) >>= mapM (init_post_meta_data) (posts, pager) <- posts'.paged put s { uid , pager , posts , S.resource_title = tag_name.Tag.resource_title_from_name } tag_view :: View tag_view = TagV.view > output_html tag :: Application tag = run tag_controller tag_view tag_feed_controller :: Controller tag_feed_controller = do init_state s <- get let uid = s.env.uri.split "/" .init .join "/" tag_name = Tag.get_name uid case Tag.tag_map' (s.tags) .Map.lookup tag_name of Nothing -> not_found Just post_set -> do posts <- post_set .to_list .rsort .take (s.config.number_of_latest_posts) .mapM (to_us > T.get >io) ^ map (Tag.fill_tag (s.tags)) put s { uid , posts , S.tag_name = tag_name } tag_feed_view :: View tag_feed_view s = RSSV.rss s (s.config.tag_id) (s.S.tag_name) .render_rss .to_sb .output_plain_rss tag_feed :: Application tag_feed = run tag_feed_controller tag_feed_view