Commit 8faeb845 authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

shown index.

parent 965ae3f0
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 6f934390ceb9630c08b299a4f4bf6f1857c01efdc878ac6e48af496d77c2e38b
-- hash: 3fbfd29efd03fac59b725b0b8693799e72aa4ffe7f2fb1b9d0b9fed69543d1cc
name: Cirkeltrek
version: 0.0.0
......@@ -16,6 +16,7 @@ library
DBOp.CRUDForum
Flux.AdmCategory
Flux.AdmForum
Flux.Home
Foundation
Handler.Adm.Category
Handler.Adm.Forum
......
......@@ -6,9 +6,10 @@
module DBOp.CRUDCategory where
import Import hiding ((==.))
import Import hiding (Value, groupBy, (==.))
import Database.Esqueleto
import Database.Esqueleto.PostgreSQL
insertCategory ::
(BaseBackend backend ~ SqlBackend, PersistStoreWrite backend, MonadIO m)
......@@ -46,3 +47,48 @@ deleteCategory cid = do
where_ (category ^. CategoriesId ==. val cid)
return category
forM_ cat (deleteCascade . entityKey)
selectCategoriesForIndex ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> ReaderT backend m [( Text
, Maybe [Key Forums]
, Maybe [Text]
, Maybe [Maybe Text]
, Maybe [Int]
, Maybe [Int]
, Maybe [Maybe UTCTime]
, Maybe [Maybe (Key Posts)]
, Maybe [Maybe Text])]
selectCategoriesForIndex = do
catnameandforums <-
select $
from $ \(category, forum) -> do
where_ (category ^. CategoriesId ==. forum ^. ForumsCategoryId)
groupBy (category ^. CategoriesName)
return
( category ^. CategoriesName
, arrayAgg (forum ^. ForumsId)
, arrayAgg (forum ^. ForumsName)
, arrayAgg (forum ^. ForumsDescriptions)
, arrayAgg (forum ^. ForumsTopicsCount)
, arrayAgg (forum ^. ForumsRepliesCount)
, arrayAgg (forum ^. ForumsLastPost)
, arrayAgg (forum ^. ForumsLastPostId)
, arrayAgg (forum ^. ForumsLastPoster))
return $
map
(\(a, b, c, d, e, f, g, h, i) ->
( unValue a
, unValue b
, unValue c
, unValue d
, unValue e
, unValue f
, unValue g
, unValue h
, unValue i))
catnameandforums
......@@ -55,3 +55,4 @@ deleteForumById fid = do
where_ (forum ^. ForumsId ==. val fid)
return forum
forM_ forums (deleteCascade . entityKey)
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Flux.Home where
import Import hiding (Value)
import Database.Esqueleto
import DBOp.CRUDCategory
getCategoriesForIndex ::
( BackendCompatible SqlBackend (YesodPersistBackend site)
, PersistQueryRead (YesodPersistBackend site)
, PersistUniqueRead (YesodPersistBackend site)
, YesodPersist site
)
=> HandlerFor site [( Text
, [( Key Forums
, Text
, Maybe Text
, Int
, Int
, Maybe UTCTime
, Maybe (Key Posts)
, Maybe Text)])]
getCategoriesForIndex = do
categoriesandforums <- liftHandler $ runDB $ selectCategoriesForIndex
return $ map anu categoriesandforums
where
anu s =
case s of
(a, Just b, Just c, Just d, Just e, Just f, Just g, Just h, Just i) ->
(a, zip8 b c d e f g h i)
(a, _, _, _, _, _, _, _, _) -> (a, [])
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Handler.Adm.Category where
import Import
......@@ -36,16 +36,9 @@ getAdmCategoryR = do
(widc, enctc) <- generateFormPost createCategoryForm
allcategories <- getAllCategories
(widl, enctl) <- generateFormPost $ selectCategoryForm allcategories
defaultLayout
[whamlet|
<form method=post enctype=#{enctc}>
^{widc}
<input .button-primary name=create value=create type=submit>
<hr>
<form method=post enctype=#{enctl}>
^{widl}
<input .button-primary name=delete value=delete type=submit>
|]
defaultLayout $ do
setTitle "Category Administration"
$(widgetFile "adm-category")
postAdmCategoryR :: Handler Html
postAdmCategoryR = do
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Handler.Adm.Forum where
import Import
......@@ -33,26 +33,7 @@ getAdmForumR = do
catfnamekeys <- getForumsAndItsCategory
(wid, enct) <- generateFormPost $ createForumForm allcategories
defaultLayout $ do
[whamlet|
<h3> Create Forum
<form method=post action=@{AdmForumR} enctype=#{enct}>
^{wid}
<input .button-primary name=create value=create type=submit>
<h3> Delete Forums
<form method=post action=@{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>
|]
$(widgetFile "adm-forum")
postAdmForumR :: Handler Html
postAdmForumR = do
......@@ -61,8 +42,6 @@ postAdmForumR = do
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
......@@ -79,3 +58,4 @@ postAdmForumR = do
deletions <- lookupPostParams "delete-forum-id"
deleteForums g deletions
redirect AdmForumR
_ -> invalidArgs ["What do you want? Create or delete?"]
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Handler.Home where
import Import
import Database.Esqueleto
import Flux.Home
getHomeR :: Handler Html
getHomeR =
getHomeR = do
categoriesforindex <- getCategoriesForIndex
defaultLayout $ do
setTitle "Nice"
[whamlet|
<h4> Nice.
|]
setTitle "Index"
$(widgetFile "home")
{-# LANGUAGE NoImplicitPrelude #-}
module Import.Util
( forceTextToInt64
, zip8
) where
import ClassyPrelude.Yesod
......@@ -10,3 +11,30 @@ forceTextToInt64 t =
case readMay t of
Just i -> i :: Int64
Nothing -> 0
zip8 ::
[a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [(a, b, c, d, e, f, g, h)]
zip8 = zipWith8 (,,,,,,,)
zipWith8 ::
(t -> t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> t7 -> a)
-> [t]
-> [t1]
-> [t2]
-> [t3]
-> [t4]
-> [t5]
-> [t6]
-> [t7]
-> [a]
zipWith8 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) (h:hs) =
z a b c d e f g h : zipWith8 z as bs cs ds es fs gs hs
zipWith8 z _ _ _ _ _ _ _ _ = []
<form method=post enctype=#{enctc}>
^{widc}
<input .button-primary name=create value=create type=submit>
<hr>
<form method=post enctype=#{enctl}>
^{widl}
<input .button-primary name=delete value=delete type=submit>
\ No newline at end of file
<h3> Create Forum
<form method=post action=@{AdmForumR} enctype=#{enct}>
^{wid}
<input .button-primary name=create value=create type=submit>
<h3> Delete Forums
<form method=post action=@{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>
\ No newline at end of file
$forall (category, forums) <- categoriesforindex
<h4>
<strong> #{category}
<table>
<thead>
<tr>
<th width="40%"> Name
<th width="10%"> Topics
<th width="10%"> Replies
<th width="20%"> Last Active
<th width="10%"> Last Poster
<tbody>
$forall (kf, fname, fdesc, ftop, frep, flp, flpid, flposter) <- forums
<tr>
<td>
<strong>
<a href=#{fromSqlKey kf}> #{fname}
<span>
<small>
$maybe desc <- fdesc
#{desc}
$nothing
<td> #{ftop}
<td> #{frep}
$maybe lastpost <- flp
$maybe lastpostid <- flpid
<td> <a href=#{fromSqlKey lastpostid}> #{show lastpost}
$nothing
<td> Never
$nothing
<td> Nothing
$maybe lastposter <- flposter
<td> #{lastposter}
$nothing
<td> Never
\ No newline at end of file
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