packages feed

bamboo-2009.6.6: src/Bamboo/Controller/Post.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NamedFieldPuns #-}

module Bamboo.Controller.Post where

import Bamboo.Controller.Env
import qualified Bamboo.Model.Counter as Counter
import qualified Bamboo.Model.Post as Post
import qualified Bamboo.Type as T
import qualified Bamboo.Type.State as S
import qualified Bamboo.View.Control.Post as PostV

post_controller :: Controller
post_controller = do
  init_state
  
  env <- get ^ env
  let uid = env .uri .Post.uri_to_id
  
  post_model <- T.get uid .io >>= init_post_meta_data
  
  let posts = [post_model]
  comments <- list_for uid .io
  
  if has_extension Counter then Counter.hit uid .io else return ()
  
  s <- get
  human_test_data <- S.mk_human_test .io
  put s
    { uid
    , S.resource_title = post_model.resource_title
    , human_test_data
    , posts
    , comments
    }

post_view :: View
post_view = PostV.view > output_html

post :: Application
post = run post_controller post_view