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:
-- IO 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)
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

blog_regex = "^/[0-9][0-9]-[0-9][0-9]-[0-9][0-9]"
  
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    )
  ]

per_page = G.per_page

index = do
  blogs <- Post.list.liftIO
  p <- paginate per_page $ blogs.length
  tags <- Tag.list.liftIO
  let nav = if p.Pager.current == 1 then home_nav else no_navigation
  let state = S.empty { S.uid = G.blog_id, S.pager = p, S.tags = tags, S.nav_location = nav }
  
  blogs.map (Tag.fill_tag tags).mapM ( Comment.fill_comment_size >>> liftIO ) 
    ^ PostV.list state >>= output_html


index_feed = do
  blogs <- Post.list.liftIO
  blogs.RSSV.rss "" "" .output

blog = do
  id <- uri ^ ("blog/" ++)
  blog <- Post.get id .liftIO
  comments <- Comment.list_for id .liftIO
  tags <- Tag.list.liftIO
  
  let state = S.empty { S.uid = id, S.tags = tags, S.resource_title = blog.resource_title }
  blog.Tag.fill_tag tags .Comment.fill_comment_size .liftIO
    ^ PostV.view state comments >>= output_html

static = do
  id <- uri
  static_page <- Static.get id .liftIO
  tags <- Tag.list.liftIO
  
  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.liftIO
  let tag_name = Tag.get_name id
  case Tag.tag_map' tags .Map.lookup tag_name of
    Nothing -> "page not found" .output
    Just blog_set -> do
      blogs <- blog_set.to_list.rsort.mapM (Post.get) .liftIO ^ map (Tag.fill_tag tags)
      p <- paginate per_page $ blogs.length
      let state = S.empty { S.uid = id, S.pager = p, S.tags = tags, S.resource_title = tag_name.Tag.resource_title_from_name }
      blogs.TagV.view state.output_html


tag_feed = do
  id <- uri ^ (split "/" >>> init >>> join "/")
  tags <- Tag.list.liftIO
  let tag_name = Tag.get_name id
  case Tag.tag_map' tags .Map.lookup tag_name of
    Nothing -> "page not found" .output
    Just blog_set -> do
      blogs <- blog_set.to_list.rsort.mapM (Post.get) .liftIO ^ map (Tag.fill_tag tags)
      blogs.RSSV.rss "tag" tag_name.output

search = do
  s <- param_with_default "s" ""
  blogs <- Post.search s .liftIO

  p <- paginate per_page $ blogs.length
  tags <- Tag.list.liftIO
  query <- uri
  let state = S.empty { S.uid = query, S.pager = p, S.tags = tags, S.resource_title = query }

  blogs.map (Tag.fill_tag tags) .SearchV.view state s.output_html



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


-- create helper, should be refactored to some common aspect
check_create =
  [ validate "author"  ( length >>> (> 0))
  , validate "url"     (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