Helper.hs

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

module Bamboo.Controller.Helper where


import Bamboo.Env hiding (get, p)
import Bamboo.Helper.StateHelper
import Bamboo.Type.State
import Control.Monad.State
import Data.Default
import Data.List hiding (length)
import Data.Maybe
import Hack
import Bamboo.Controller.Type
import qualified Hack
import System.IO as IO
import qualified Bamboo.Model.Post as Post
import qualified Bamboo.Model.Tag as Tag
import qualified Bamboo.Model.Comment as Comment
import qualified Bamboo.Type.Pager as Pager
import qualified Bamboo.Type.State as S
import qualified Hack.Contrib.Request as Request


data CachedController = CachedController
  {
    etag_controller :: ETagController
  , controller :: Controller
  }

init_state :: Controller
init_state = fill_latest_posts >> fill_tags

params, inputs :: Env -> Assoc
params = Request.params > map_fst b2u > map_snd b2u
inputs = Request.inputs > map_fst b2u > map_snd b2u

param_with_default, input_with_default :: String -> String -> Env -> String
param_with_default s d env = env .get_param s .fromMaybe d
input_with_default s d env = env .get_input s .fromMaybe d

get_param, get_input :: String -> Env -> Maybe String
get_param s env = env .params .lookup s
get_input s env = env .inputs .lookup s

just_param, just_input :: String -> Env -> String
just_param s env = env .get_param s .fromJust
just_input s env = env .get_input s .fromJust

only_for :: Extension -> (a -> IO Response) -> a -> IO Response
only_for ext x = if has_extension ext then x else const not_found_response

io :: (MonadIO m) => IO a -> m a
io = liftIO

blog_regex :: String
blog_regex = static_config.url_date_matcher


fill_latest_posts :: Part ()
fill_latest_posts = do
  s <- get
  latest_posts <- Post.latest ( s.config.number_of_latest_posts ) .io
  put s { latest_posts }

fill_tags :: Part ()
fill_tags = do
  s <- get
  tags <- list .io
  put s { tags }

paginate :: [a] -> Part Pager
paginate xs = do
  s <- get
  let per_page' = s.config.per_page
      current = s.env.param_with_default "page" "1" .read
      total = xs.length
      has_next = current * per_page' < total.from_i
      has_previous = current `gt` n1
      next         = current + n1
      previous     = current + (- n1)
      n1 = 1 :: Int
  
  return def 
    {
      Pager.per_page = per_page'
    , current       
    , has_next      
    , has_previous  
    , next          
    , previous
    , total      
    }

paged :: [a] -> Part ([a], Pager)
paged xs = do
  pager <- paginate xs
  return (xs.for_current_page pager, pager)
  
for_current_page :: Pager -> [a] -> [a]
for_current_page p xs = 
  xs.drop ((p.current - 1) * p.Pager.per_page) .take (p.Pager.per_page)


init_post_meta_data :: Post.Post -> Part Post.Post
init_post_meta_data x = do
  tags <- get ^ tags
  x.Tag.fill_tag tags.Comment.fill_comment_size.io

run :: Controller -> View -> Application
run x v env = do
  s <- execStateT x def {env}
  v s
  
  
  {- cache should

      * get tag from env
      * get tag from current controller
      * if equal
          then return unmodify
          else return data
  -}

not_found :: Controller
not_found = get >>= \s -> put s {S.status = 404}

not_found_response :: IO Response
not_found_response = return $ def { Hack.status = 404 }