added group sharing

src/Handler/TodoEntry.hs

@@ -11,14 +11,12 @@ module Handler.TodoEntry where
 
 import Import
 import Text.Read
-import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey)
-import GHC.RTS.Flags (TraceFlags(user))
+import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey, rawSql)
 -- TODO: move this back to another handler
 getHomeR :: Handler Html
 getHomeR = do
-    user <- getUserId
-    groups <- runDB $ do
-        selectList [GroupUserUser ==. user] [Asc GroupUserGroup]
+    userId <- getUserId
+    groups <- getGroups userId
     mToken <- fmap reqToken getRequest
     defaultLayout $ do
         setTitle "Groups"
@@ -27,7 +25,7 @@ getHomeR = do
             <ul>
                 $forall group <- groups
                     <li>
-                        <a href=@{TodolistR $ (groupUserGroupId . entityVal) group}>#{(groupUserGroup . entityVal) group}
+                        <a href=@{TodolistR $ entityKey group}>#{(groupGroup . entityVal) group}
             <form action=@{AddGroupR} method="post">
                 <input type="text" name="group" placeholder="new group">
                 $maybe token <- mToken
@@ -43,7 +41,7 @@ postAddGroupR = do
     user <- getUserId
     _ <- runDB $ do
         gId <- insert $ Group g
-        success <- insertUnique $ GroupUser user g gId
+        success <- insertUnique $ GroupUser user gId
         when (isNothing success) $ delete gId
     redirect HomeR
 postAddTodolistR :: GroupId -> Handler Html
@@ -193,8 +191,7 @@ postEditTodolistR groupId = error "not done yet"
 getEditGroupR :: Handler Html
 getEditGroupR = do
     userId <- getUserId
-    groups <- runDB $ do
-        selectList [GroupUserUser ==. userId] [Asc GroupUserGroup]
+    groups <- getGroups userId
     mToken <- fmap reqToken getRequest
     defaultLayout $ do
         let a e = pack $ show $ fromSqlKey $ entityKey e ::Text
@@ -205,7 +202,7 @@ getEditGroupR = do
                     $forall group <- groups
                         <li>
                             <input type="checkbox" name="ids" value="#{a group}">
-                            <a href="">#{(groupUserGroup . entityVal) group}
+                            <a href="">#{(groupGroup . entityVal) group}
                 $maybe token <- mToken
                     <input type="hidden" name="_token" value="#{token}">
                 <button type=submit>Delete selected 
@@ -233,7 +230,14 @@ postDeleteGroupR = do
 
 postAddUserR :: GroupId -> Handler Html
 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
 
 getText :: Entity TodolistItem -> Text
@@ -270,6 +274,11 @@ postSortTodolistItemsR  groupId todolistId = do
         _ -> setSession "sort" "value"
     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
 getUserId :: HandlerFor App (Key User)
 getUserId = do