{-# 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 }