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

Category deletion by Administrator.

parent a42e7196
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module DBOp.CRUDCategory where
import Import
import Import hiding ((==.))
import Database.Esqueleto
......@@ -23,8 +24,25 @@ selectAllCategory ::
, MonadIO m
)
=> ReaderT b m [Entity Categories]
selectAllCategory =
selectAllCategory = do
select $
from $ \category -> do
orderBy [asc (category ^. CategoriesName)]
return category
from $ \category -> do
orderBy [asc (category ^. CategoriesName)]
return category
deleteCategory ::
( BaseBackend backend ~ SqlBackend
, PersistQueryWrite backend
, BackendCompatible SqlBackend backend
, PersistUniqueRead backend
, MonadIO m
)
=> Key Categories
-> ReaderT backend m ()
deleteCategory cid = do
cat <-
select $
from $ \category -> do
where_ (category ^. CategoriesId ==. val cid)
return category
forM_ cat (deleteCascade . entityKey)
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Flux.AdmCategory where
......@@ -32,3 +33,17 @@ getAllCategories ::
=> HandlerFor site [Entity Categories]
getAllCategories = liftHandler $ runDB $ selectAllCategory
deleteCategoryCascade ::
( BaseBackend (YesodPersistBackend (HandlerSite m)) ~ SqlBackend
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryWrite (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Grouping
-> Key Categories
-> m ()
deleteCategoryCascade Administrator cid = liftHandler $ runDB $ deleteCategory cid
deleteCategoryCascade _ _ =
permissionDenied "You're not allowed to do this (category deletion)."
......@@ -48,20 +48,35 @@ getAdmCategoryR = do
[whamlet|
<form method=post enctype=#{enctc}>
^{widc}
<input .button-primary value=create type=submit>
<input .button-primary name=create value=create type=submit>
<hr>
<form method=post enctype=#{enctl}>
^{widl}
<input .button-primary value=delete type=submit>
<input .button-primary name=delete 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!"]
createparam <- lookupPostParam "create"
deleteparam <- lookupPostParam "delete"
case (createparam, deleteparam) of
(Nothing, Nothing) -> invalidArgs ["At least be sure of what you want."]
(Just _, Nothing) -> do
((res, _), _) <- runFormPost createCategoryForm
case res of
FormFailure x -> invalidArgs x
FormSuccess r -> do
_ <- createCategory group (createCategoryFormName r)
redirect AdmCategoryR
_ -> invalidArgs ["Good job, smarty pants!"]
(Nothing, Just _) -> do
allcategories <- getAllCategories
((res, _), _) <- runFormPost $ selectCategoryForm allcategories
case res of
FormFailure x -> invalidArgs x
FormSuccess r -> do
deleteCategoryCascade group $ toSqlKey $ selectCategoryFormId r
redirect AdmCategoryR
_ -> invalidArgs ["Good job, smarty pants!"]
(Just _, Just _) -> invalidArgs ["Make up your mind, my dear admin."]
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