Commit 965ae3f0 authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

forum deletion.

parent 1a62efe4
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: e0bfc42472f36a14d5ffc913f6b4a579cab5854f302ec6a7df6122cf9fba9171
-- hash: 6f934390ceb9630c08b299a4f4bf6f1857c01efdc878ac6e48af496d77c2e38b
name: Cirkeltrek
version: 0.0.0
......@@ -23,6 +23,7 @@ library
Handler.Profile
Import
Import.NoFoundation
Import.Util
Model
Model.Grouping
Settings
......
......@@ -6,9 +6,52 @@
module DBOp.CRUDForum where
import Import hiding ((==.))
import Import hiding (Value, groupBy, on,
(==.))
import Database.Esqueleto
import Database.Esqueleto
import Database.Esqueleto.PostgreSQL
insertForum ::
(BaseBackend backend ~ SqlBackend, PersistStoreWrite backend, MonadIO m)
=> Key Categories
-> Text
-> Maybe Text
-> ReaderT backend m ()
insertForum cid name desc = do
insert_ $ Forums cid name desc 0 0 Nothing Nothing Nothing
selectAllForumsAndCategoryName ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> ReaderT backend m [(Text, Maybe [Text], Maybe [Key Forums])]
selectAllForumsAndCategoryName = do
catnameandforums <-
select $
from $ \(category, forum) -> do
where_ (category ^. CategoriesId ==. forum ^. ForumsCategoryId)
groupBy (category ^. CategoriesName)
return
( category ^. CategoriesName
, arrayAgg (forum ^. ForumsName)
, arrayAgg (forum ^. ForumsId))
return $
map (\(a, b, c) -> (unValue a, unValue b, unValue c)) catnameandforums
deleteForumById ::
( BaseBackend backend ~ SqlBackend
, PersistQueryWrite backend
, MonadIO m
, BackendCompatible SqlBackend backend
, PersistUniqueRead backend
)
=> Key Forums
-> ReaderT backend m ()
deleteForumById fid = do
forums <- select $ from $ \forum -> do
where_ (forum ^. ForumsId ==. val fid)
return forum
forM_ forums (deleteCascade . entityKey)
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Flux.AdmForum where
import Import
import Import hiding (Value)
import Database.Esqueleto
import DBOp.CRUDForum
......@@ -26,3 +28,35 @@ createForum Administrator cid name desc =
liftHandler $ runDB $ insertForum cid name desc
createForum _ _ _ _ =
permissionDenied "You're not allowed to do this (create forum)."
getForumsAndItsCategory ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryRead (YesodPersistBackend (HandlerSite m))
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> m [(Text, [(Text, Key Forums)])]
getForumsAndItsCategory = do
something <- liftHandler $ runDB $ selectAllForumsAndCategoryName
return $ map (\(cname, mts, mks) -> (cname, spread mts mks)) something
where
spread (Just ts) (Just ks) = zip ts ks
spread (Just _) Nothing = []
spread Nothing _ = []
deleteForums ::
( BaseBackend (YesodPersistBackend (HandlerSite m)) ~ SqlBackend
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryWrite (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Grouping
-> [Text]
-> m ()
deleteForums Administrator fids =
liftHandler $
runDB $ forM_ fids (deleteForumById . toSqlKey . forceTextToInt64)
deleteForums _ _ = permissionDenied "You're not allowed to do this (delete forum)"
......@@ -30,6 +30,7 @@ getAdmForumR :: Handler Html
getAdmForumR = do
(u, n, g) <- allowedToAdmin
allcategories <- getAllCategories
catfnamekeys <- getForumsAndItsCategory
(wid, enct) <- generateFormPost $ createForumForm allcategories
defaultLayout $ do
[whamlet|
......@@ -37,20 +38,44 @@ getAdmForumR = do
<form method=post [email protected]{AdmForumR} enctype=#{enct}>
^{wid}
<input .button-primary name=create value=create type=submit>
<h3> Delete Forums
<form method=post [email protected]{AdmForumR} enctype=#{enct}>
$forall (catname, fnamekeys) <- catfnamekeys
<h4> Category: #{catname}
<table>
<thead>
<th width="70%"> Name
<th> Delete
<tbody>
$forall (name, key) <- fnamekeys
<tr>
<td> #{name}
<td> <input name=delete-forum-id value=#{fromSqlKey key} type=checkbox>
<input .button-primary name=delete value=delete 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)
createparam <- lookupPostParam "create"
deleteparam <- lookupPostParam "delete"
case (createparam, deleteparam) of
(Nothing, Nothing) -> invalidArgs ["What do you want? Create or delete?"]
(Just _, Just _) -> invalidArgs ["What do you want? Create or delete?"]
(Just _, Nothing) -> do
((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!"]
(Nothing, Just _) -> do
deletions <- lookupPostParams "delete-forum-id"
deleteForums g deletions
redirect AdmForumR
_ -> invalidArgs ["Good job, smarty pants!"]
......@@ -4,3 +4,4 @@ module Import
import Foundation as Import
import Import.NoFoundation as Import
import Import.Util as Import
{-# LANGUAGE NoImplicitPrelude #-}
module Import.Util
( forceTextToInt64
) where
import ClassyPrelude.Yesod
forceTextToInt64 :: Text -> Int64
forceTextToInt64 t =
case readMay t of
Just i -> i :: Int64
Nothing -> 0
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