Application.hs

-- the controller is the most complex module for a reason:
-- models are made as simple and small as possible
-- views are pure functions.

-- a note on encoding:
-- IOs are in utf-8 filter, internally use bytes

{-# OPTIONS -fno-monomorphism-restriction #-}

module Panda.Controller.Application where

import qualified Data.Map as Map

-- env
import Panda.Helper.Env hiding (tag, uri)
import Panda.Helper.StateHelper
import Prelude hiding ((.), (/), (^), id)
import qualified Panda.Type.State as S
import qualified Panda.Config.Global as G
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
import qualified Panda.Model.Comment as Comment

-- view
import qualified Panda.View.Control.Post as PostV
import qualified Panda.View.Widget.Template as T
import qualified Panda.View.Control.Static as StaticV
import qualified Panda.View.Control.Tag as TagV
import qualified Panda.View.Control.Search as SearchV
import qualified Panda.View.Widget.RSS as RSSV

-- helpers
-- liftIO: move to an (u)pper level monad
u = liftIO
blog_regex = G.url_date_matcher

init_post tags x = do
  x.Tag.fill_tag tags.Comment.fill_comment_size.u

tag_list = Tag.list.u


-- main controller

pages = 
  [ ("$"                  ,index             )
  , ("(\\?.+)?$"          ,index             )
  , ("rss.xml$"           ,index_feed        )
  , (blog_regex           ,blog              )
  , ("static/."           ,static            )
  , ("tag/.*/rss.xml$"    ,tag_feed          )
  , ("tag/."              ,tag               )
  , ("search"             ,search            )
  , ("comment/create"     ,comment_create    )
  ] .map_fst ((G.root /) >>> ("^" ++))
  ++
  [ ("^" ++ G.root ++ "$"          ,index      )]


index = do
  posts <- Post.list.u
  p <- paginate posts
  tags <- tag_list
  let nav = if p.Pager.current == 1 then home_nav else no_navigation
  let state = S.empty { S.uid = G.post_id, S.pager = p, S.tags = tags, S.nav_location = nav }
  
  posts.mapM (init_post tags) ^ PostV.list state >>= output_html

index_feed = do
  posts <- Post.list.u
  posts.RSSV.rss "" "" .output

blog = do
  id <- uri ^ Post.uri_to_id
  blog <- Post.get id .u
  comments <- Comment.list_for id .u
  tags <- tag_list
  
  let state = S.empty { S.uid = id, S.tags = tags, S.resource_title = blog.resource_title }
  blog.(init_post tags) ^ PostV.view state comments >>= output_html

static = do
  id <- uri
  static_page <- Static.get id .u
  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
  let state = S.empty { 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 = do
  id <- 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 (Post.get) .u >>= mapM (init_post tags)
      p <- paginate posts
      let state = S.empty { S.uid = id, S.pager = p, S.tags = tags, S.resource_title = tag_name.Tag.resource_title_from_name }
      posts.TagV.view state.output_html

tag_feed = do
  id <- 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 (Post.get) .u ^ map (Tag.fill_tag tags)
      posts.RSSV.rss G.tag_id tag_name.output

search = do
  s <- param_with_default "s" ""
  posts <- Post.search s .u

  p <- paginate posts
  tags <- tag_list
  query <- uri
  let state = S.empty { 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

comment_create = do
  post_id <- input_with_default "post_id" (G.post_id / "nothing")
  exists <- (G.flat_uri / post_id.to_utf8) .doesFileExist .u
  let valid_path = equalFilePath G.post_id (takeDirectory post_id)
  checked <- check_create
  
  if [checked, valid_path, exists].and
    then
      inputs >>= (Comment.create >>> liftIO)
    else
      return ()
  redirect $ (post_id.Post.id_to_uri.to_utf8).urlEncode


-- create helper, should be refactored to some common aspect
check_create =
  [ validate "author"  ( length >>> (> 0))
  , validate "author_link"     (const True)
  , validate "comment" ( length >>> (> 0))
  , validate "human_hack" (is "10")
  ] .sequence ^ and


validate s f = do
  maybe_s <- get_input s
  case maybe_s of
    Nothing -> return False
    Just v -> return $ f v