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.

-- I believe this leads to more robust system, and provides much more
-- flexibility in both design and implementation


{-# 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 Panda.Type.State hiding (pager)
import qualified Panda.Config.Global as Config
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

-- view
import qualified Panda.View.Theme.BluePrint.Post as PostV
import qualified Panda.View.Theme.BluePrint.Template.Template as T
import qualified Panda.View.Theme.BluePrint.Static as StaticV
import qualified Panda.View.Theme.BluePrint.Tag as TagV
import qualified Panda.View.Theme.BluePrint.Search as SearchV
import qualified Panda.View.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            )
  ]

per_page = Config.per_page

index = do
  blogs <- Post.list.liftIO
  p <- pager per_page $ blogs.length
  tags <- Tag.list.liftIO
  let nav = if p.Pager.current == 1 then home_nav else no_navigation
  let state = State Config.blog_id p tags nav
  
  blogs.map (Tag.fill_tag tags) .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
  tags <- Tag.list.liftIO
  
  let state = State id Pager.empty tags no_navigation
  blog.Tag.fill_tag tags .PostV.view state .output_html

static = do
  id <- uri
  static_page <- Static.get id .liftIO
  tags <- Tag.list.liftIO
  
  let nav = if title.belongs_to Config.navigation then title else no_navigation where title = static_page.Static.title
  let state = State id Pager.empty tags nav
  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 <- pager per_page $ blogs.length
      let state = State id p tags no_navigation
      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 <- pager per_page $ blogs.length
  tags <- Tag.list.liftIO
  query <- uri
  let state = State query p tags no_navigation

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