added group sharing
This commit is contained in:
parent
20ce55f22a
commit
ee514454f7
2 changed files with 20 additions and 12 deletions
|
|
@ -16,5 +16,4 @@ Group
|
||||||
group Text
|
group Text
|
||||||
GroupUser
|
GroupUser
|
||||||
user UserId
|
user UserId
|
||||||
group Text
|
|
||||||
groupId GroupId OnDeleteCascade
|
groupId GroupId OnDeleteCascade
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue