added group sharing

This commit is contained in:
Stuce 2025-06-26 09:53:56 +01:00
parent 20ce55f22a
commit ee514454f7
2 changed files with 20 additions and 12 deletions

View file

@ -16,5 +16,4 @@ Group
group Text group Text
GroupUser GroupUser
user UserId user UserId
group Text
groupId GroupId OnDeleteCascade groupId GroupId OnDeleteCascade

View file

@ -11,14 +11,12 @@ module Handler.TodoEntry where
import Import import Import
import Text.Read import Text.Read
import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey) import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey, rawSql)
import GHC.RTS.Flags (TraceFlags(user))
-- TODO: move this back to another handler -- TODO: move this back to another handler
getHomeR :: Handler Html getHomeR :: Handler Html
getHomeR = do getHomeR = do
user <- getUserId userId <- getUserId
groups <- runDB $ do groups <- getGroups userId
selectList [GroupUserUser ==. user] [Asc GroupUserGroup]
mToken <- fmap reqToken getRequest mToken <- fmap reqToken getRequest
defaultLayout $ do defaultLayout $ do
setTitle "Groups" setTitle "Groups"
@ -27,7 +25,7 @@ getHomeR = do
<ul> <ul>
$forall group <- groups $forall group <- groups
<li> <li>
<a href=@{TodolistR $ (groupUserGroupId . entityVal) group}>#{(groupUserGroup . entityVal) group} <a href=@{TodolistR $ entityKey group}>#{(groupGroup . entityVal) group}
<form action=@{AddGroupR} method="post"> <form action=@{AddGroupR} method="post">
<input type="text" name="group" placeholder="new group"> <input type="text" name="group" placeholder="new group">
$maybe token <- mToken $maybe token <- mToken
@ -43,7 +41,7 @@ postAddGroupR = do
user <- getUserId user <- getUserId
_ <- runDB $ do _ <- runDB $ do
gId <- insert $ Group g gId <- insert $ Group g
success <- insertUnique $ GroupUser user g gId success <- insertUnique $ GroupUser user gId
when (isNothing success) $ delete gId when (isNothing success) $ delete gId
redirect HomeR redirect HomeR
postAddTodolistR :: GroupId -> Handler Html postAddTodolistR :: GroupId -> Handler Html
@ -193,8 +191,7 @@ postEditTodolistR groupId = error "not done yet"
getEditGroupR :: Handler Html getEditGroupR :: Handler Html
getEditGroupR = do getEditGroupR = do
userId <- getUserId userId <- getUserId
groups <- runDB $ do groups <- getGroups userId
selectList [GroupUserUser ==. userId] [Asc GroupUserGroup]
mToken <- fmap reqToken getRequest mToken <- fmap reqToken getRequest
defaultLayout $ do defaultLayout $ do
let a e = pack $ show $ fromSqlKey $ entityKey e ::Text let a e = pack $ show $ fromSqlKey $ entityKey e ::Text
@ -205,7 +202,7 @@ getEditGroupR = do
$forall group <- groups $forall group <- groups
<li> <li>
<input type="checkbox" name="ids" value="#{a group}"> <input type="checkbox" name="ids" value="#{a group}">
<a href="">#{(groupUserGroup . entityVal) group} <a href="">#{(groupGroup . entityVal) group}
$maybe token <- mToken $maybe token <- mToken
<input type="hidden" name="_token" value="#{token}"> <input type="hidden" name="_token" value="#{token}">
<button type=submit>Delete selected <button type=submit>Delete selected
@ -233,7 +230,14 @@ postDeleteGroupR = do
postAddUserR :: GroupId -> Handler Html postAddUserR :: GroupId -> Handler Html
postAddUserR groupId= do postAddUserR groupId= do
-- DB action user <- runInputPost $ ireq textField "user"
_ <- dbIfAuth groupId (do
mUserId <- getBy $ UniqueName user
case mUserId of
Nothing -> --handle error
redirect $ TodolistR groupId
Just userId -> insert $ GroupUser (entityKey userId) groupId
)
redirect $ TodolistR groupId redirect $ TodolistR groupId
getText :: Entity TodolistItem -> Text getText :: Entity TodolistItem -> Text
@ -270,6 +274,11 @@ postSortTodolistItemsR groupId todolistId = do
_ -> setSession "sort" "value" _ -> setSession "sort" "value"
redirect $ TodolistItemsR groupId todolistId redirect $ TodolistItemsR groupId todolistId
getGroups :: Key User -> Handler [Entity Group]
getGroups userId =
let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" in
runDB $ rawSql sql [toPersistValue userId]
-- TODO: complete implementation should short circuit if multi user is on but no user exist -- TODO: complete implementation should short circuit if multi user is on but no user exist
getUserId :: HandlerFor App (Key User) getUserId :: HandlerFor App (Key User)
getUserId = do getUserId = do