-- 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:
-- uniform utf-8 enforced by custom io wrapper

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

module Panda.Controller.Application where

import qualified Data.Map as Map

-- env
import Panda.Helper.Env hiding (tag, uri)
import Panda.Helper.StateHelper hiding (only_for)
import qualified Panda.Type.State as S
import qualified Panda.Config.Global as G
import qualified Panda.Type.Pager as Pager
import Panda.Type.Extension

-- 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.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 = x.Tag.fill_tag tags.Comment.fill_comment_size.u
tag_list         = list.u


-- main controller

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

only_for ext x = if has_extension ext then x else not_found

default_state = do
  latest_posts <- Post.latest G.number_of_latest_posts.u
  def { S.latest_posts = latest_posts } .return

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

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

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


static = do
  id <- uri
  static_page <- 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
  s <- default_state
  let state = s { 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 (get) .u >>= mapM (init_post tags)
      p <- paginate posts
      s <- default_state
      let state = s { S.uid = id, S.tags = tags, S.pager = p, 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 (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
  s' <- default_state
  let state = s' { 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 (show_data Comment.PostId) (G.post_id / "nothing")
  exists <- (G.flat_uri / post_id) .file_exist .u 
  let valid_path = equalFilePath G.post_id (takeDirectory post_id) 
  checked <- check_create
  
  if [checked, valid_path, exists].and
    then
      inputs >>= (Comment.create_comment > u)
    else
      return ()
  redirect $ (post_id.Post.id_to_uri.u2b).urlEncode

get_input_data = show_data > get_input

check_human = do
  [l, r, op, h] <- [Comment.LeftNumber, Comment.RightNumber, Comment.Operator, Comment.HumanHack].mapM get_input_data ^ map fromJust
  return $ S.simple_eval (l.read) (r.read) (op.S.read_op) .is (h.read)

-- create helper, should be refactored to some common aspect
check_create =
  [ validate Comment.Author       ( length > (`gt` 0))
  , validate Comment.AuthorLink   ( const True)
  , validate Comment.Body         ( length > (`gt` 0))
  , validate Comment.EmptyField   ( empty )
  , validate Comment.LeftNumber   ( belongs_to (S.nums.map show))
  , validate Comment.RightNumber  ( belongs_to (S.nums.map show))
  , validate Comment.Operator     ( belongs_to (S.ops.map S.display_op))
  , validate Comment.HumanHack    ( belongs_to (S.nums.map show))
  , check_human
  ] .sequence ^ and


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