Application.hs

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

module Panda.Controller.Application where

import qualified Data.Map as Map

-- env
import Panda.Helper.Env
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.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 else Other
  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 Other
  blog.Tag.fill_tag tags .PostV.view state .output_html

static = do
  id <- uri
  tags <- Tag.list.liftIO
  
  let nav = if id.split "/" .tail.join "/" == "about" then About else Other
  let state = State id Pager.empty tags nav
  (Config.flat_uri / id) .readFile .liftIO <.> StaticV.view state >>= output_html

tag = do
  id <- uri
  tags <- Tag.list.liftIO
  let tag_name = Tag.id_to_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 Other
      blogs.TagV.view state.output_html

tag_feed = do
  id <- uri <.> (split "/" >>> init >>> join "/")
  tags <- Tag.list.liftIO
  let tag_name = Tag.id_to_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.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 Other

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