Commit 1a62efe4 authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

inserted forum.

parent de5e9c34
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 40064a7405d71b43fd66e1b51719d76bf74d9ac7f26fbaadf3eed1ba1b13173d
-- hash: e0bfc42472f36a14d5ffc913f6b4a579cab5854f302ec6a7df6122cf9fba9171
name: Cirkeltrek
version: 0.0.0
......@@ -13,9 +13,12 @@ library
exposed-modules:
Application
DBOp.CRUDCategory
DBOp.CRUDForum
Flux.AdmCategory
Flux.AdmForum
Foundation
Handler.Adm.Category
Handler.Adm.Forum
Handler.Home
Handler.Profile
Import
......
......@@ -27,6 +27,7 @@ import Settings (ApplicationSettings (..),
import Handler.Home
import Handler.Profile
import Handler.Adm.Category
import Handler.Adm.Forum
mkYesodDispatch "App" resourcesApp
......
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module DBOp.CRUDForum where
import Import hiding ((==.))
import Database.Esqueleto
insertForum cid name desc = do
insert_ $ Forums cid name desc 0 0 Nothing Nothing Nothing
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Flux.AdmForum where
import Import
import DBOp.CRUDForum
createForum ::
( BaseBackend (YesodPersistBackend (HandlerSite m)) ~ SqlBackend
, PersistStoreWrite (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Grouping
-> Key Categories
-> Text
-> Maybe Text
-> m ()
createForum Administrator cid name desc =
liftHandler $ runDB $ insertForum cid name desc
createForum _ _ _ _ =
permissionDenied "You're not allowed to do this (create forum)."
......@@ -37,6 +37,7 @@ mkYesodData
/auth SigninR Auth getAuth
/profile ProfileR GET
/admin/category AdmCategoryR GET POST
/admin/forum AdmForumR GET POST
|]
type Form a = Html -> MForm (HandlerFor App) (FormResult a, Widget)
......@@ -129,3 +130,11 @@ instance YesodAuth App where
Just (Entity uid _) -> return $ Authenticated uid
instance YesodAuthPersist App
allowedToAdmin :: Handler (Key Users, Text, Grouping)
allowedToAdmin = do
midnamegroup <- getUserAndGrouping
case midnamegroup of
Nothing -> permissionDenied "You're not allowed to see this page."
(Just (uid, name, Administrator)) -> return (uid, name, Administrator)
(Just (uid, name, _)) -> permissionDenied "You're not the admin of this site."
......@@ -30,14 +30,6 @@ selectCategoryForm cats =
catlist =
map (\(Entity cid (Categories name)) -> (name, fromSqlKey $ cid)) cats
allowedToAdmin :: Handler (Key Users, Text, Grouping)
allowedToAdmin = do
midnamegroup <- getUserAndGrouping
case midnamegroup of
Nothing -> permissionDenied "You're not allowed to see this page."
(Just (uid, name, Administrator)) -> return (uid, name, Administrator)
(Just (uid, name, _)) -> permissionDenied "You're not the admin of this site."
getAdmCategoryR :: Handler Html
getAdmCategoryR = do
(uid, name, group) <- allowedToAdmin
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Handler.Adm.Forum where
import Import
import Database.Esqueleto
import Flux.AdmCategory
import Flux.AdmForum
data CreateForumForm = CreateForumForm
{ createForumFormName :: Text
, createForumFormDesc :: Maybe Textarea
, createForumFormCategory :: Int64
} deriving (Show)
createForumForm :: [Entity Categories] -> Form CreateForumForm
createForumForm cats = renderDivs $
CreateForumForm
<$> areq textField "Forum Name" Nothing
<*> aopt textareaField "Description" Nothing
<*> areq (selectFieldList catlist) "Category" Nothing
where
catlist =
map (\(Entity cid (Categories name)) -> (name, fromSqlKey cid)) cats
getAdmForumR :: Handler Html
getAdmForumR = do
(u, n, g) <- allowedToAdmin
allcategories <- getAllCategories
(wid, enct) <- generateFormPost $ createForumForm allcategories
defaultLayout $ do
[whamlet|
<h3> Create Forum
<form method=post [email protected]{AdmForumR} enctype=#{enct}>
^{wid}
<input .button-primary name=create value=create type=submit>
|]
postAdmForumR :: Handler Html
postAdmForumR = do
(u, n, g) <- allowedToAdmin
allcategories <- getAllCategories
((res, _), _) <- runFormPost $ createForumForm allcategories
case res of
FormFailure x -> invalidArgs x
FormSuccess r -> do
createForum
g
(toSqlKey $ createForumFormCategory r)
(createForumFormName r)
(unTextarea <$> createForumFormDesc r)
redirect AdmForumR
_ -> invalidArgs ["Good job, smarty pants!"]
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment