Tag.hs

{-# 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