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

user data. posts and topics.

parent eab4acf5
......@@ -92,3 +92,18 @@ updatePostContent pid content = do
update $ \post -> do
set post [PostsContent =. val content]
where_ (post ^. PostsId ==. val pid)
selectPostByPosterId ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Key Users
-> ReaderT backend m [Entity Posts]
selectPostByPosterId userid = do
select $
from $ \post -> do
where_ (post ^. PostsUserId ==. val userid)
orderBy [desc (post ^. PostsTime)]
return post
......@@ -70,3 +70,20 @@ updateTopicIncrementReplyAndLasts tid username pid now = do
, TopicsLastPost =. (val $ Just now)
]
where_ (topic ^. TopicsId ==. val tid)
selectTopicForumNameByPosterId ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Key Users
-> ReaderT backend m [(Value Text, Entity Topics)]
selectTopicForumNameByPosterId userid = do
select $
from $ \(forum `InnerJoin` topic `InnerJoin` user) -> do
on (topic ^. TopicsPoster ==. user ^. UsersUsername)
on (topic ^. TopicsForumId ==. forum ^. ForumsId)
where_ (user ^. UsersId ==. val userid)
orderBy [asc (topic ^. TopicsLastPost)]
return (forum ^. ForumsName, topic)
......@@ -170,3 +170,13 @@ updateUserPassword uid password = do
update $ \user -> do
set user [UsersPassword =. val password]
where_ (user ^. UsersId ==. val uid)
updateUserIncrementPost uid = do
update $ \user -> do
set user [UsersRepliesPosted +=. val 1]
where_ (user ^. UsersId ==. val uid)
updateUserIncrementTopic uid = do
update $ \user -> do
set user [UsersTopicsStarted +=. val 1]
where_ (user ^. UsersId ==. val uid)
......@@ -12,6 +12,7 @@ import Database.Esqueleto
import DBOp.CRUDForum
import DBOp.CRUDPost
import DBOp.CRUDTopic
import DBOp.CRUDUser
import Flux.Topic
......@@ -60,6 +61,7 @@ createTopicByPosting fid userid username subject content = do
liftHandler $ runDB $ do
_ <- insertPost tid 1 username userid content
updateForumIncrementTopic fid
updateUserIncrementTopic userid
return tid
lockUnlockTopic ::
......
......@@ -11,6 +11,7 @@ import Database.Esqueleto
import DBOp.CRUDForum
import DBOp.CRUDPost
import DBOp.CRUDTopic
import DBOp.CRUDUser
import Handler.User
......@@ -49,4 +50,5 @@ replyTopicByPosting uid uname tid content = do
pid
now
updateTopicIncrementReplyAndLasts tid uname pid now
updateUserIncrementPost uid
return (tid, page, num + 2)
......@@ -11,6 +11,8 @@ import Database.Esqueleto
import Yesod.Auth.Util.PasswordStore
import DBOp.CRUDGroup
import DBOp.CRUDPost
import DBOp.CRUDTopic
import DBOp.CRUDUser
import Flux.Miscellaneous
......@@ -143,6 +145,15 @@ selfUpdateInfoByUser userid userpass oldpass newpass email = do
updateUserPassword userid (Just $ decodeUtf8 newpassword)
else invalidArgs ["Your password don't match with the old one."]
updateInfoByAdmin ::
( YesodPersistBackend (HandlerSite m) ~ SqlBackend
, MonadHandler m
, YesodPersist (HandlerSite m)
)
=> Key Users
-> Maybe Text
-> Text
-> m ()
updateInfoByAdmin userid Nothing email = liftHandler $ runDB $ updateUserEmail userid email
updateInfoByAdmin userid (Just np) email =
liftHandler $
......@@ -150,3 +161,27 @@ updateInfoByAdmin userid (Just np) email =
newpassword <- liftIO $ makePassword (encodeUtf8 np) 17
updateUserEmail userid email
updateUserPassword userid (Just $ decodeUtf8 newpassword)
getUserPosts ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryRead (YesodPersistBackend (HandlerSite m))
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Key Users
-> m [Entity Posts]
getUserPosts = liftHandler . runDB . selectPostByPosterId
getUserTopics ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryRead (YesodPersistBackend (HandlerSite m))
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Key Users
-> m [(Text, Entity Topics)]
getUserTopics userid = do
topics <- liftHandler . runDB . selectTopicForumNameByPosterId $ userid
return $ map (\(Value forumname, x) -> (forumname, x)) topics
......@@ -41,6 +41,8 @@ mkYesodData
/user/#Int64 UserR GET
/user/#Int64/edit UserEditR GET POST
/user/#Int64/admin UserAdminR GET POST
/user/#Int64/posts UserPostsR GET
/user/#Int64/topics UserTopicsR GET
/admin AdmR GET
/admin/category AdmCategoryR GET POST
/admin/forum AdmForumR GET POST
......@@ -218,11 +220,13 @@ allowedToEditProfile uid group profileid =
profileid == uid || group == Administrator
profileRouteToText :: Route App -> Text
profileRouteToText ProfileR = "Common Information"
profileRouteToText (UserR _) = "Common Information"
profileRouteToText (UserEditR _) = "Edit Common Information"
profileRouteToText (UserAdminR _) = "Promote User"
profileRouteToText _ = "Not Needed"
profileRouteToText ProfileR = "Common Information"
profileRouteToText (UserR _) = "Common Information"
profileRouteToText (UserEditR _) = "Edit Common Information"
profileRouteToText (UserAdminR _) = "Promote User"
profileRouteToText (UserPostsR _) = "User Posts"
profileRouteToText (UserTopicsR _) = "User Topics"
profileRouteToText _ = "Not Needed"
data SortBy
= Username
......
......@@ -250,3 +250,17 @@ postUserAdminR userid = do
banUser uid name group (username) (ip) (message)
redirect $ UserR userid
_ -> invalidArgs ["Please fill the form correctly."]
getUserPostsR :: Int64 -> Handler Html
getUserPostsR userid = do
(uid, name, group) <- allowedToPost
user'@(Entity uid' user) <- getUserById $ toSqlKey userid
posts <- getUserPosts $ toSqlKey userid
profileLayout uid name group user' $(widgetFile "profile-info-posts")
getUserTopicsR :: Int64 -> Handler Html
getUserTopicsR userid = do
(uid, name, group) <- allowedToPost
user'@(Entity uid' user) <- getUserById $ toSqlKey userid
topics <- getUserTopics $ toSqlKey userid
profileLayout uid name group user' $(widgetFile "profile-info-topics")
<a [email protected]{UserR userid}>
<p> Go back
<table>
<thead>
<th width="30%"> When
<th width="70%"> What
<tbody>
$forall (Entity key (Posts tid n uname _ t content)) <- posts
<tr>
<td>
<a [email protected]{PostR $ fromSqlKey key}> #{show $ utcToLocalTime timeZone $ t}
<td> #{content}
<a [email protected]{UserR userid}>
<p> Go back
<table>
<thead>
<th> Forum
<th> Subject
<th> Replies
<th> Start Time
<th> Last Active
<th> Last Poster
<tbody>
$forall (fname, (Entity key (Topics fid poster subject repcount start lastpost lastpostid lastposter locked))) <- topics
<tr>
<td> <a [email protected]{ForumR $ fromSqlKey fid}> #{fname}
<td> <a [email protected]{TopicR $ fromSqlKey key}> #{subject}
<td> #{repcount}
<td> #{show $ utcToLocalTime timeZone start}
$maybe last <- lastpost
$maybe lastid <- lastpostid
<td>
<a [email protected]{PostR $ fromSqlKey lastid}> #{show $ utcToLocalTime timeZone last}
$nothing
<td> Still Empty.
$nothing
<td> Still Empty.
$maybe last <- lastposter
<td> #{last}
$nothing
<td> Still Empty.
......@@ -17,9 +17,9 @@
<.column>
<p> Topic Started:
<.column.column-75>
<a href="#"> <p> #{usersTopicsStarted user}
<a href=@{UserTopicsR uid}> <p> #{usersTopicsStarted user}
<.row>
<.column>
<p> Reply Posted:
<.column.column-75>
<a href="#"> <p> #{usersRepliesPosted user}
<a href=@{UserPostsR uid}> <p> #{usersRepliesPosted user}
......@@ -12,7 +12,7 @@ $forall (Entity pid (Posts tid n uname posterid t content)) <- posts
<span .float-right #post-#{n}> #{n}
<.row.row-no-padding>
<.column.column-20>
<a [email protected]{HomeR}> #{uname}
<a [email protected]{UserR $ fromSqlKey posterid}> #{uname}
<.column.column-80>
<.row>
<.column.column-100> #{content}
......
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