Commit 092932cd authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

user data. search.

parent 4e414cb8
......@@ -2,6 +2,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
......@@ -68,6 +69,15 @@ updateUserGroupingByUsername username grouping = do
set user [UsersGroupId =. val (entityKey x)]
where_ (user ^. UsersUsername ==. val username)
qbuilder ::
(PersistField a, Esqueleto query expr backend, PersistEntity ent)
=> expr (Entity ent)
-> EntityField ent a
-> Maybe a
-> expr (Value Bool)
qbuilder _ _ Nothing = val True
qbuilder ent accessor (Just v) = ent ^. accessor ==. val v
selectUsersByConditions ::
( PersistUniqueRead backend
, PersistQueryRead backend
......@@ -88,6 +98,57 @@ selectUsersByConditions mgid musername memail = do
&&. user ^. UsersGroupId ==. group ^. GroupsId)
orderBy [asc (user ^. UsersUsername)]
return (user, group ^. GroupsGrouping)
where
qbuilder _ _ Nothing = (val True)
qbuilder user accessor (Just v) = (user ^. accessor ==. val v)
selectUsersBySearchConditions ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Maybe Text
-> Maybe (Key Groups)
-> SortBy
-> Bool
-> ReaderT backend m [(Value Grouping, Entity Users)]
selectUsersBySearchConditions username groupid orderby ascending = do
select $
from $ \(user, group) -> do
where_
(qbuilder group GroupsId groupid
&&. qbuilder user UsersUsername username
&&. user ^. UsersGroupId ==. group ^. GroupsId)
ordering ascending user orderby
return (group ^. GroupsGrouping, user)
ordering ::
Esqueleto query expr backend
=> Bool
-> expr (Entity Users)
-> SortBy
-> query ()
ordering b user Username = orderBy [(chooseAscension b) (user ^. UsersUsername)]
ordering b user Registered = orderBy [(chooseAscension b) (user ^. UsersJoinTime)]
ordering b user PostCount = orderBy [(chooseAscension b) (user ^. UsersRepliesPosted)]
chooseAscension :: (Esqueleto query expr backend, PersistField a) => Bool -> expr (Value a) -> expr OrderBy
chooseAscension True e = asc e
chooseAscension False e = desc e
selectAllUsers ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Bool
-> ReaderT backend m [(Value Grouping, Entity Users)]
selectAllUsers ascending = do
let op =
if ascending
then asc
else desc
select $
from $ \(user, group) -> do
where_ (user ^. UsersGroupId ==. group ^. GroupsId)
orderBy [op (user ^. UsersUsername)]
return (group ^. GroupsGrouping, user)
iaji@melati.6460:1526569009
\ No newline at end of file
......@@ -13,6 +13,8 @@ import Yesod.Auth.Util.PasswordStore
import DBOp.CRUDGroup
import DBOp.CRUDUser
import Flux.Miscellaneous
unusedUser ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryRead (YesodPersistBackend (HandlerSite m))
......@@ -78,3 +80,21 @@ getUsersByConditions mgid musername memail = do
userandgroup <-
liftHandler $ runDB $ selectUsersByConditions mgid musername memail
return $ map (\(user, Value group) -> (user, group)) userandgroup
getAllUsers ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryRead (YesodPersistBackend (HandlerSite m))
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Bool
-> m [(Grouping, Entity Users)]
getAllUsers ascending = do
groupandusers <- liftHandler $ runDB $ selectAllUsers ascending
return $ map (\(Value a, x) -> (a, x)) groupandusers
searchUserByConditions username groupid orderby ascending = do
groupandusers <- liftHandler $ runDB $ selectUsersBySearchConditions username groupid orderby ascending
return $ map (\(Value a, x) -> (a, x)) groupandusers
......@@ -55,6 +55,7 @@ mkYesodData
/post/#Int64 PostR GET
/post/#Int64/edit PostEditR GET POST
/post/#Int64/report PostReportR GET POST
/userlist UserListR GET POST
|]
type Form a = Html -> MForm (HandlerFor App) (FormResult a, Widget)
......@@ -218,3 +219,14 @@ profileRouteToText :: Route App -> Text
profileRouteToText ProfileR = "Common Information"
profileRouteToText (UserR _) = "Common Information of user"
profileRouteToText _ = "Not Needed"
data SortBy
= Username
| Registered
| PostCount
deriving (Eq, Enum, Bounded)
instance Show SortBy where
show Username = "Username"
show Registered = "Registration Date"
show PostCount = "Post Count"
......@@ -9,6 +9,7 @@ import Import
import Data.Time.LocalTime
import Database.Persist.Sql
import Flux.Miscellaneous
import Flux.User
data RegisterForm = RegisterForm
......@@ -24,6 +25,33 @@ registerForm =
<*> areq passwordField "Password" Nothing
<*> areq emailField "Email" Nothing
data SearchUserForm = SearchUserForm
{ searchUserFormUsername :: Maybe Text
, searchUserFormGroup :: Maybe Int64
, searchUserFormSortBy :: SortBy
, searchUserFormAscending :: Bool
}
searchUserForm :: [Entity Groups] -> Form SearchUserForm
searchUserForm groups = renderDivs $
SearchUserForm
<$> aopt textField "Username" Nothing
<*> aopt (selectFieldList glist) "Groups" Nothing
<*> areq (selectFieldList slist) "Sort By" Nothing
<*> areq (selectFieldList alist) "Sort Order" Nothing
where
glist :: [(Text, Int64)]
glist =
map
(\x ->
( pack . show . groupsGrouping $ entityVal x
, fromSqlKey . entityKey $ x))
groups
slist :: [(Text, SortBy)]
slist = map (pack . show &&& id) [minBound .. maxBound]
alist :: [(Text, Bool)]
alist = [("Ascending", True), ("Descending", False)]
getRegisterR :: Handler Html
getRegisterR = do
isNotLoggedIn
......@@ -58,3 +86,35 @@ getUserR uid = do
(ruid, name, group) <- allowedToPost
user'@(Entity uid' user) <- getUserById $ toSqlKey uid
profileLayout ruid name group user' $(widgetFile "profile-info")
getUserListR :: Handler Html
getUserListR = do
(uid, name, group) <- allowedToPost
let users = [] :: [(Grouping, Entity Users)]
ad <- getGroup Administrator
mo <- getGroup Moderator
me <- getGroup Member
(wid, enct) <- generateFormPost $ searchUserForm [ad, mo, me]
defaultLayout $ do
setTitle "User List"
$(widgetFile "user-list")
postUserListR :: Handler Html
postUserListR = do
(uid, name, group) <- allowedToPost
ad <- getGroup Administrator
mo <- getGroup Moderator
me <- getGroup Member
((res, wid), enct) <- runFormPost $ searchUserForm [ad, mo, me]
case res of
FormSuccess r -> do
let (username, groupid, orderby, ascending) =
( searchUserFormUsername r
, toSqlKey <$> searchUserFormGroup r
, searchUserFormSortBy r
, searchUserFormAscending r)
users <- searchUserByConditions username groupid orderby ascending
defaultLayout $ do
setTitle "User List"
$(widgetFile "user-list")
_ -> error ""
......@@ -6,7 +6,7 @@
<li .navigation-item>
<a .navigation-link [email protected]{AdmR} title="Management"> Management
<li .navigation-item>
<a .navigation-link href="#" title="Users"> Users
<a .navigation-link href=@{UserListR} title="Users"> Users
<ul .navigation-list.float-right>
<li .navigation-item>
<a .navigation-link [email protected]{ProfileR}> Profile
......
......@@ -9,15 +9,15 @@
<li .navigation-item>
<a .navigation-link [email protected]{AdmR}> Administration
<li .navigation-item>
<a .navigation-link href="#" title="Users"> Users
<a .navigation-link href=@{UserListR} title="Users"> Users
$of Moderator
<li .navigation-item>
<a .navigation-link [email protected]{AdmR}> Administration
<li .navigation-item>
<a .navigation-link href="#" title="Users"> Users
<a .navigation-link href=@{UserListR} title="Users"> Users
$of Member
<li .navigation-item>
<a .navigation-link href="#" title="Users"> Users
<a .navigation-link href=@{UserListR} title="Users"> Users
$of Banned
<ul .navigation-list.float-right>
......
......@@ -8,15 +8,15 @@
<li .navigation-item>
<a .navigation-link [email protected]{AdmR} title="Management"> Management
<li .navigation-item>
<a .navigation-link href="#" title="Users"> Users
<a .navigation-link href=@{UserListR} title="Users"> Users
$of Moderator
<li .navigation-item>
<a .navigation-link [email protected]{AdmR} title="Management"> Management
<li .navigation-item>
<a .navigation-link href="#" title="Users"> Users
<a .navigation-link href=@{UserListR} title="Users"> Users
$of Member
<li .navigation-item>
<a .navigation-link href="#" title="Users"> Users
<a .navigation-link href=@{UserListR} title="Users"> Users
$of Banned
<ul .navigation-list.float-right>
<li .navigation-item>
......
<form method=post [email protected]{UserListR} enctype=#{enct}>
^{wid}
<input .button-primary name=search value=search type=submit>
<table>
<thead>
<tr>
<th> Username
<th> Title
<th> Posts
<th> Registered
<tbody>
$forall (group, Entity keyuser (Users _ uname email _ joined ts rp)) <- users
<tr>
<td>
<a [email protected]{UserR $ fromSqlKey keyuser}> #{uname}
<td> #{show group}
<td> #{rp}
<td> #{show $ utcToLocalTime timeZone joined}
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