diff --git a/src/Vervis/Handler/Group.hs b/src/Vervis/Handler/Group.hs index 2b56252..c8b4986 100644 --- a/src/Vervis/Handler/Group.hs +++ b/src/Vervis/Handler/Group.hs @@ -32,7 +32,8 @@ import Prelude import Control.Monad.IO.Class (liftIO) import Data.Maybe (fromMaybe) import Data.Time.Clock (getCurrentTime) -import Database.Esqueleto +import Database.Esqueleto hiding ((==.), (!=.), delete) +import Database.Persist import Text.Blaze.Html (Html) import Yesod.Auth (requireAuthId) import Yesod.Core (defaultLayout, setMessage) @@ -41,6 +42,8 @@ import Yesod.Form.Functions (runFormPost) import Yesod.Form.Types (FormResult (..)) import Yesod.Persist.Core (runDB, getBy404) +import qualified Database.Esqueleto as E + import Vervis.Form.Group import Vervis.Foundation import Vervis.Model @@ -53,7 +56,7 @@ import Vervis.Widget.Sharer (groupLinkW, personLinkW) getGroupsR :: Handler Html getGroupsR = do groups <- runDB $ select $ from $ \ (sharer, group) -> do - where_ $ sharer ^. SharerId ==. group ^. GroupIdent + where_ $ sharer ^. SharerId E.==. group ^. GroupIdent orderBy [asc $ sharer ^. SharerIdent] return sharer defaultLayout $(widgetFile "group/list") @@ -111,9 +114,9 @@ getGroupMembersR shar = do Entity gid _g <- getBy404 $ UniqueGroup sid ms <- select $ from $ \ (member, person, sharer) -> do where_ $ - member ^. GroupMemberGroup ==. val gid &&. - member ^. GroupMemberPerson ==. person ^. PersonId &&. - person ^. PersonIdent ==. sharer ^. SharerId + member ^. GroupMemberGroup E.==. val gid &&. + member ^. GroupMemberPerson E.==. person ^. PersonId &&. + person ^. PersonIdent E.==. sharer ^. SharerId orderBy [ asc $ member ^. GroupMemberRole , asc $ sharer ^. SharerIdent @@ -163,10 +166,49 @@ getGroupMemberNewR shar = do defaultLayout $(widgetFile "group/member/new") getGroupMemberR :: ShrIdent -> ShrIdent -> Handler Html -getGroupMemberR grp memb = error "Not implemented" +getGroupMemberR grp memb = do + member <- runDB $ do + gid <- do + Entity s _ <- getBy404 $ UniqueSharer grp + Entity g _ <- getBy404 $ UniqueGroup s + return g + pid <- do + Entity s _ <- getBy404 $ UniqueSharer memb + Entity p _ <- getBy404 $ UniquePersonIdent s + return p + Entity _mid m <- getBy404 $ UniqueGroupMember pid gid + return m + defaultLayout $(widgetFile "group/member/one") deleteGroupMemberR :: ShrIdent -> ShrIdent -> Handler Html -deleteGroupMemberR grp memb = error "Not implemented" +deleteGroupMemberR grp memb = do + succ <- runDB $ do + gid <- do + Entity s _ <- getBy404 $ UniqueSharer grp + Entity g _ <- getBy404 $ UniqueGroup s + return g + pid <- do + Entity s _ <- getBy404 $ UniqueSharer memb + Entity p _ <- getBy404 $ UniquePersonIdent s + return p + mm <- + selectFirst + [ GroupMemberGroup ==. gid + , GroupMemberPerson !=. pid + , GroupMemberRole ==. GRAdmin + ] + [] + case mm of + Nothing -> return False + Just _ -> do + Entity mid _m <- getBy404 $ UniqueGroupMember pid gid + delete mid + return True + setMessage $ + if succ + then "Group member removed." + else "Can’t leave a group without an admin." + redirect $ GroupMembersR grp postGroupMemberR :: ShrIdent -> ShrIdent -> Handler Html postGroupMemberR grp memb = do diff --git a/templates/group/member/one.hamlet b/templates/group/member/one.hamlet new file mode 100644 index 0000000..427e80f --- /dev/null +++ b/templates/group/member/one.hamlet @@ -0,0 +1,19 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ Copying is an act of love. Please copy, reuse and share. +$# +$# The author(s) have dedicated all copyright and related and neighboring +$# rights to this software to the public domain worldwide. This software is +$# distributed without any warranty. +$# +$# You should have received a copy of the CC0 Public Domain Dedication along +$# with this software. If not, see +$# . + +

+ Role: #{show $ groupMemberRole member}. + +

+ Joined on #{showDate $ groupMemberJoined member}.