module Bamboo.Controller.Helper where
import Bamboo.Controller.Type
import Bamboo.Env hiding (get)
import Bamboo.Type.State
import Control.Monad.State
import Data.Default
import Data.List hiding (length)
import Data.Maybe
import Hack
import System.IO as IO
import qualified Bamboo.Model.Comment as Comment
import qualified Bamboo.Model.Post as Post
import qualified Bamboo.Model.Tag as Tag
import qualified Bamboo.Type.Pager as Pager
import qualified Bamboo.Type.State as S
import qualified Hack
import qualified Hack.Contrib.Request as Request
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
io :: (MonadIO m) => IO a -> m a
io = liftIO
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 = execStateT x def {env} >>= v
not_found :: Controller
not_found = get >>= \s -> put s {S.status = 404}