Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Switch to GitLab Next
Sign in / Register
Toggle navigation
Open sidebar
Ibnu Daru Aji
Cirkeltrek
Commits
de5e9c34
Commit
de5e9c34
authored
Apr 26, 2018
by
Ibnu Daru Aji
Browse files
Category deletion by Administrator.
parent
a42e7196
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
70 additions
and
22 deletions
+70
-22
src/DBOp/CRUDCategory.hs
src/DBOp/CRUDCategory.hs
+27
-9
src/Flux/AdmCategory.hs
src/Flux/AdmCategory.hs
+19
-4
src/Handler/Adm/Category.hs
src/Handler/Adm/Category.hs
+24
-9
No files found.
src/DBOp/CRUDCategory.hs
View file @
de5e9c34
{-# 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
)
src/Flux/AdmCategory.hs
View file @
de5e9c34
{-# 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)."
src/Handler/Adm/Category.hs
View file @
de5e9c34
...
...
@@ -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."
]
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment