Commit a42e7196 authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

Created category creation and listing categories.

parent be2dd0d1
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
......@@ -6,6 +7,8 @@ module DBOp.CRUDCategory where
import Import
import Database.Esqueleto
insertCategory ::
(BaseBackend backend ~ SqlBackend, PersistStoreWrite backend, MonadIO m)
=> Text
......@@ -13,3 +16,15 @@ insertCategory ::
insertCategory catname = do
insert $ Categories catname
selectAllCategory ::
( PersistUniqueRead b
, PersistQueryRead b
, BackendCompatible SqlBackend b
, MonadIO m
)
=> ReaderT b m [Entity Categories]
selectAllCategory =
select $
from $ \category -> do
orderBy [asc (category ^. CategoriesName)]
return category
......@@ -9,8 +9,26 @@ import Import
import DBOp.CRUDCategory
createCategory ::
( BaseBackend (YesodPersistBackend (HandlerSite m)) ~ SqlBackend
, PersistStoreWrite (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Grouping
-> Text
-> m (Key Categories)
createCategory Administrator catname =
liftHandler $ runDB $ insertCategory catname
createCategory _ _ =
permissionDenied "You're not allowed to do this (category creation)."
getAllCategories ::
( BackendCompatible SqlBackend (YesodPersistBackend site)
, PersistQueryRead (YesodPersistBackend site)
, PersistUniqueRead (YesodPersistBackend site)
, YesodPersist site
)
=> HandlerFor site [Entity Categories]
getAllCategories = liftHandler $ runDB $ selectAllCategory
......@@ -36,7 +36,7 @@ mkYesodData
/static StaticR Static appStatic
/auth SigninR Auth getAuth
/profile ProfileR GET
/admin/category AdmCategoryR GET
/admin/category AdmCategoryR GET POST
|]
type Form a = Html -> MForm (HandlerFor App) (FormResult a, Widget)
......
......@@ -30,13 +30,38 @@ 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
(widc, enctc) <- generateFormPost createCategoryForm
allcategories <- getAllCategories
(widl, enctl) <- generateFormPost $ selectCategoryForm allcategories
defaultLayout
[whamlet|
<form enctype=#{enctc}>
<form method=post enctype=#{enctc}>
^{widc}
<input .button-primary value=create type=submit>
<hr>
<form method=post enctype=#{enctl}>
^{widl}
<input .button-primary value=delete type=submit>
|]
postAdmCategoryR :: Handler Html
postAdmCategoryR = do
(uid, name, group) <- allowedToAdmin
((res, _), _) <- runFormPost createCategoryForm
case res of
FormFailure x -> invalidArgs x
FormSuccess r -> do
_ <- createCategory group (createCategoryFormName r)
redirect AdmCategoryR
_ -> 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