mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 17:44:52 +09:00
Add project roles, basically a copy of the repo role code
This commit is contained in:
parent
10c27464dd
commit
4e0e8cb736
16 changed files with 514 additions and 13 deletions
|
@ -73,6 +73,26 @@ RepoCollab
|
|||
|
||||
UniqueRepoCollab repo person
|
||||
|
||||
ProjectRole
|
||||
ident RlIdent
|
||||
person PersonId
|
||||
desc Text
|
||||
|
||||
UniqueProjectRole person ident
|
||||
|
||||
ProjectAccess
|
||||
role ProjectRoleId
|
||||
op ProjectOperation
|
||||
|
||||
UniqueProjectAccess role op
|
||||
|
||||
ProjectCollab
|
||||
project ProjectId
|
||||
person PersonId
|
||||
role ProjectRoleId
|
||||
|
||||
UniqueProjectCollab project person
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Projects
|
||||
-------------------------------------------------------------------------------
|
||||
|
|
|
@ -56,6 +56,12 @@
|
|||
/rr/#RlIdent/a RepoRoleOpsR GET POST
|
||||
/rr/#RlIdent/a/!new RepoRoleOpNewR GET
|
||||
|
||||
/pr ProjectRolesR GET POST
|
||||
/pr/!new ProjectRoleNewR GET
|
||||
/pr/#RlIdent ProjectRoleR GET DELETE POST
|
||||
/pr/#RlIdent/a ProjectRoleOpsR GET POST
|
||||
/pr/#RlIdent/a/!new ProjectRoleOpNewR GET
|
||||
|
||||
-- ----------------------------------------------------------------------------
|
||||
-- Projects
|
||||
-- ----------------------------------------------------------------------------
|
||||
|
@ -78,6 +84,9 @@
|
|||
/s/#ShrIdent/p ProjectsR GET POST
|
||||
/s/#ShrIdent/p/!new ProjectNewR GET
|
||||
/s/#ShrIdent/p/#PrjIdent ProjectR GET
|
||||
/s/#ShrIdent/p/#PrjIdent/d ProjectDevsR GET POST
|
||||
/s/#ShrIdent/p/#PrjIdent/d/!new ProjectDevNewR GET
|
||||
/s/#ShrIdent/p/#PrjIdent/d/#ShrIdent ProjectDevR GET DELETE POST
|
||||
|
||||
/s/#ShrIdent/p/#PrjIdent/t TicketsR GET POST
|
||||
/s/#ShrIdent/p/#PrjIdent/t/!new TicketNewR GET
|
||||
|
|
|
@ -16,6 +16,8 @@
|
|||
module Vervis.Field.Role
|
||||
( newRepoRoleIdentField
|
||||
, newRepoOpField
|
||||
, newProjectRoleIdentField
|
||||
, newProjectOpField
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -40,12 +42,12 @@ import Vervis.Model
|
|||
import Vervis.Model.Ident (RlIdent, rl2text, text2rl)
|
||||
import Vervis.Model.Role
|
||||
|
||||
roleIdentField :: Field Handler RlIdent
|
||||
roleIdentField = convertField text2rl rl2text textField
|
||||
|
||||
newRepoRoleIdentField :: PersonId -> Field Handler RlIdent
|
||||
newRepoRoleIdentField pid = checkUniqueCI pid roleIdentField
|
||||
where
|
||||
roleIdentField :: Field Handler RlIdent
|
||||
roleIdentField = convertField text2rl rl2text textField
|
||||
|
||||
checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
|
||||
checkUniqueCI pid = checkM $ \ rl -> do
|
||||
sames <- runDB $ select $ from $ \ role -> do
|
||||
|
@ -75,3 +77,36 @@ newRepoOpField getrid = checkOpNew getrid opField
|
|||
return $ case ma of
|
||||
Nothing -> Right op
|
||||
Just _ -> Left ("Role already has this operation" :: Text)
|
||||
|
||||
newProjectRoleIdentField :: PersonId -> Field Handler RlIdent
|
||||
newProjectRoleIdentField pid = checkUniqueCI pid roleIdentField
|
||||
where
|
||||
checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
|
||||
checkUniqueCI pid = checkM $ \ rl -> do
|
||||
sames <- runDB $ select $ from $ \ role -> do
|
||||
where_ $
|
||||
role ^. ProjectRolePerson ==. val pid &&.
|
||||
lower_ (role ^. ProjectRoleIdent) ==. lower_ (val rl)
|
||||
limit 1
|
||||
return ()
|
||||
return $ if null sames
|
||||
then Right rl
|
||||
else Left ("This role name is already in use" :: Text)
|
||||
|
||||
newProjectOpField :: AppDB ProjectRoleId -> Field Handler ProjectOperation
|
||||
newProjectOpField getrid = checkOpNew getrid opField
|
||||
where
|
||||
opField :: Field Handler ProjectOperation
|
||||
opField = selectField optionsEnum
|
||||
|
||||
checkOpNew
|
||||
:: AppDB ProjectRoleId
|
||||
-> Field Handler ProjectOperation
|
||||
-> Field Handler ProjectOperation
|
||||
checkOpNew getrid = checkM $ \ op -> do
|
||||
ma <- runDB $ do
|
||||
rid <- getrid
|
||||
getBy $ UniqueProjectAccess rid op
|
||||
return $ case ma of
|
||||
Nothing -> Right op
|
||||
Just _ -> Left ("Role already has this operation" :: Text)
|
||||
|
|
|
@ -15,13 +15,21 @@
|
|||
|
||||
module Vervis.Form.Project
|
||||
( newProjectForm
|
||||
, NewProjectCollab (..)
|
||||
, newProjectCollabForm
|
||||
)
|
||||
where
|
||||
|
||||
import Vervis.Import
|
||||
import Vervis.Import hiding (on, isNothing)
|
||||
|
||||
import Database.Esqueleto hiding ((==.))
|
||||
|
||||
import qualified Database.Esqueleto as E ((==.))
|
||||
|
||||
import Vervis.Field.Project
|
||||
import Vervis.Model.Ident (text2prj)
|
||||
import Vervis.Model
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Repo
|
||||
|
||||
newProjectAForm :: SharerId -> AForm Handler Project
|
||||
newProjectAForm sid = Project
|
||||
|
@ -33,3 +41,32 @@ newProjectAForm sid = Project
|
|||
|
||||
newProjectForm :: SharerId -> Form Project
|
||||
newProjectForm = renderDivs . newProjectAForm
|
||||
|
||||
data NewProjectCollab = NewProjectCollab
|
||||
{ ncPerson :: PersonId
|
||||
, ncRole :: ProjectRoleId
|
||||
}
|
||||
|
||||
newProjectCollabAForm
|
||||
:: PersonId -> ProjectId -> AForm Handler NewProjectCollab
|
||||
newProjectCollabAForm pid rid = NewProjectCollab
|
||||
<$> areq selectPerson "Person*" Nothing
|
||||
<*> areq selectRole "Role*" Nothing
|
||||
where
|
||||
selectPerson = selectField $ do
|
||||
l <- runDB $ select $
|
||||
from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
|
||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
||||
on $
|
||||
collab ?. ProjectCollabProject E.==. just (val rid) &&.
|
||||
collab ?. ProjectCollabPerson E.==. just (person ^. PersonId)
|
||||
where_ $ isNothing $ collab ?. ProjectCollabId
|
||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
||||
optionsPairs $ map (shr2text . unValue *** unValue) l
|
||||
selectRole =
|
||||
selectField $
|
||||
optionsPersistKey [ProjectRolePerson ==. pid] [] $
|
||||
rl2text . projectRoleIdent
|
||||
|
||||
newProjectCollabForm :: PersonId -> ProjectId -> Form NewProjectCollab
|
||||
newProjectCollabForm pid rid = renderDivs $ newProjectCollabAForm pid rid
|
||||
|
|
|
@ -17,6 +17,9 @@ module Vervis.Form.Role
|
|||
( NewRepoRole (..)
|
||||
, newRepoRoleForm
|
||||
, newRepoRoleOpForm
|
||||
, NewProjectRole (..)
|
||||
, newProjectRoleForm
|
||||
, newProjectRoleOpForm
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -51,3 +54,23 @@ newRepoRoleOpAForm getrid = areq (newRepoOpField getrid) "Operation*" Nothing
|
|||
|
||||
newRepoRoleOpForm :: AppDB RepoRoleId -> Form RepoOperation
|
||||
newRepoRoleOpForm getrid = renderDivs $ newRepoRoleOpAForm getrid
|
||||
|
||||
data NewProjectRole = NewProjectRole
|
||||
{ nprIdent :: RlIdent
|
||||
, nprDesc :: Text
|
||||
}
|
||||
|
||||
newProjectRoleAForm :: PersonId -> AForm Handler NewProjectRole
|
||||
newProjectRoleAForm pid = NewProjectRole
|
||||
<$> areq (newProjectRoleIdentField pid) "Name*" Nothing
|
||||
<*> areq textField "Description" Nothing
|
||||
|
||||
newProjectRoleForm :: PersonId -> Form NewProjectRole
|
||||
newProjectRoleForm pid = renderDivs $ newProjectRoleAForm pid
|
||||
|
||||
newProjectRoleOpAForm :: AppDB ProjectRoleId -> AForm Handler ProjectOperation
|
||||
newProjectRoleOpAForm getrid =
|
||||
areq (newProjectOpField getrid) "Operation*" Nothing
|
||||
|
||||
newProjectRoleOpForm :: AppDB ProjectRoleId -> Form ProjectOperation
|
||||
newProjectRoleOpForm getrid = renderDivs $ newProjectRoleOpAForm getrid
|
||||
|
|
|
@ -135,6 +135,12 @@ instance Yesod App where
|
|||
(RepoRoleOpsR _rl , _ ) -> personAny
|
||||
(RepoRoleOpNewR _rl , _ ) -> personAny
|
||||
|
||||
(ProjectRolesR , _ ) -> personAny
|
||||
(ProjectRoleNewR , _ ) -> personAny
|
||||
(ProjectRoleR _rl , _ ) -> personAny
|
||||
(ProjectRoleOpsR _rl , _ ) -> personAny
|
||||
(ProjectRoleOpNewR _rl , _ ) -> personAny
|
||||
|
||||
(ReposR shar , True) -> person shar
|
||||
(RepoNewR user , _ ) -> person user
|
||||
(RepoR shar _ , True) -> person shar
|
||||
|
@ -144,6 +150,9 @@ instance Yesod App where
|
|||
|
||||
(ProjectsR shar , True) -> person shar
|
||||
(ProjectNewR user , _ ) -> person user
|
||||
(ProjectDevsR shr _prj , _ ) -> person shr
|
||||
(ProjectDevNewR shr _prj , _ ) -> person shr
|
||||
(ProjectDevR shr _prj _dev , _ ) -> person shr
|
||||
|
||||
(TicketsR shar _ , True) -> person shar
|
||||
(TicketNewR _ _ , _ ) -> personAny
|
||||
|
@ -307,6 +316,12 @@ instance YesodBreadcrumbs App where
|
|||
RepoRoleOpsR rl -> ("Operations", Just $ RepoRoleR rl)
|
||||
RepoRoleOpNewR rl -> ("New", Just $ RepoRoleOpsR rl)
|
||||
|
||||
ProjectRolesR -> ("Project Roles", Just HomeR)
|
||||
ProjectRoleNewR -> ("New", Just ProjectRolesR)
|
||||
ProjectRoleR rl -> (rl2text rl, Just ProjectRolesR)
|
||||
ProjectRoleOpsR rl -> ("Operations", Just $ ProjectRoleR rl)
|
||||
ProjectRoleOpNewR rl -> ("New", Just $ ProjectRoleOpsR rl)
|
||||
|
||||
ReposR shar -> ("Repos", Just $ PersonR shar)
|
||||
RepoNewR shar -> ("New", Just $ ReposR shar)
|
||||
RepoR shar repo -> (rp2text repo, Just $ ReposR shar)
|
||||
|
@ -320,7 +335,9 @@ instance YesodBreadcrumbs App where
|
|||
RepoChangesR shar repo ref -> ( ref
|
||||
, Just $ RepoHeadChangesR shar repo
|
||||
)
|
||||
RepoDevsR shr rp -> ("Team", Just $ RepoR shr rp)
|
||||
RepoDevsR shr rp -> ( "Collaboratots"
|
||||
, Just $ RepoR shr rp
|
||||
)
|
||||
RepoDevNewR shr rp -> ("New", Just $ RepoDevsR shr rp)
|
||||
RepoDevR shr rp dev -> ( shr2text dev
|
||||
, Just $ RepoDevsR shr rp
|
||||
|
@ -335,6 +352,15 @@ instance YesodBreadcrumbs App where
|
|||
ProjectR shar proj -> ( prj2text proj
|
||||
, Just $ ProjectsR shar
|
||||
)
|
||||
ProjectDevsR shr prj -> ( "Collaborators"
|
||||
, Just $ ProjectR shr prj
|
||||
)
|
||||
ProjectDevNewR shr prj -> ( "New"
|
||||
, Just $ ProjectDevsR shr prj
|
||||
)
|
||||
ProjectDevR shr prj dev -> ( shr2text dev
|
||||
, Just $ ProjectDevsR shr prj
|
||||
)
|
||||
|
||||
TicketsR shar proj -> ( "Tickets"
|
||||
, Just $ ProjectR shar proj
|
||||
|
|
|
@ -18,6 +18,12 @@ module Vervis.Handler.Project
|
|||
, postProjectsR
|
||||
, getProjectNewR
|
||||
, getProjectR
|
||||
, getProjectDevsR
|
||||
, postProjectDevsR
|
||||
, getProjectDevNewR
|
||||
, getProjectDevR
|
||||
, deleteProjectDevR
|
||||
, postProjectDevR
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -26,10 +32,11 @@ import Prelude
|
|||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Database.Persist
|
||||
import Database.Esqueleto hiding (delete, (%), (==.))
|
||||
import Text.Blaze.Html (Html)
|
||||
import Yesod.Auth (requireAuth)
|
||||
import Yesod.Core (defaultLayout)
|
||||
import Yesod.Core.Handler (redirect, setMessage)
|
||||
import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
|
||||
import Yesod.Form.Functions (runFormPost)
|
||||
import Yesod.Form.Types (FormResult (..))
|
||||
import Yesod.Persist.Core (runDB, getBy404)
|
||||
|
@ -42,15 +49,16 @@ import Vervis.Model
|
|||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Repo
|
||||
import Vervis.Settings
|
||||
import Vervis.Widget.Sharer
|
||||
|
||||
getProjectsR :: ShrIdent -> Handler Html
|
||||
getProjectsR ident = do
|
||||
projects <- runDB $ E.select $ E.from $ \ (sharer, project) -> do
|
||||
E.where_ $
|
||||
sharer E.^. SharerIdent E.==. E.val ident E.&&.
|
||||
sharer E.^. SharerId E.==. project E.^. ProjectSharer
|
||||
E.orderBy [E.asc $ project E.^. ProjectIdent]
|
||||
return $ project E.^. ProjectIdent
|
||||
projects <- runDB $ select $ from $ \ (sharer, project) -> do
|
||||
where_ $
|
||||
sharer ^. SharerIdent E.==. val ident &&.
|
||||
sharer ^. SharerId E.==. project ^. ProjectSharer
|
||||
orderBy [asc $ project ^. ProjectIdent]
|
||||
return $ project ^. ProjectIdent
|
||||
defaultLayout $(widgetFile "project/list")
|
||||
|
||||
postProjectsR :: ShrIdent -> Handler Html
|
||||
|
@ -85,3 +93,94 @@ getProjectR shar proj = do
|
|||
rs <- selectList [RepoProject ==. Just pid] [Asc RepoIdent]
|
||||
return (p, rs)
|
||||
defaultLayout $(widgetFile "project/one")
|
||||
|
||||
getProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
getProjectDevsR shr rp = do
|
||||
devs <- runDB $ do
|
||||
rid <- do
|
||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||
Entity r _ <- getBy404 $ UniqueProject rp s
|
||||
return r
|
||||
select $ from $ \ (collab, person, sharer, role) -> do
|
||||
where_ $
|
||||
collab ^. ProjectCollabProject E.==. val rid &&.
|
||||
collab ^. ProjectCollabPerson E.==. person ^. PersonId &&.
|
||||
person ^. PersonIdent E.==. sharer ^. SharerId &&.
|
||||
collab ^. ProjectCollabRole E.==. role ^. ProjectRoleId
|
||||
return (sharer, role ^. ProjectRoleIdent)
|
||||
defaultLayout $(widgetFile "project/collab/list")
|
||||
|
||||
postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
postProjectDevsR shr rp = do
|
||||
(pid, rid) <- runDB $ do
|
||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||
Entity r _ <- getBy404 $ UniqueProject rp s
|
||||
return (p, r)
|
||||
((result, widget), enctype) <- runFormPost $ newProjectCollabForm pid rid
|
||||
case result of
|
||||
FormSuccess nc -> do
|
||||
runDB $ do
|
||||
let collab = ProjectCollab
|
||||
{ projectCollabProject = rid
|
||||
, projectCollabPerson = ncPerson nc
|
||||
, projectCollabRole = ncRole nc
|
||||
}
|
||||
insert_ collab
|
||||
setMessage "Collaborator added."
|
||||
redirect $ ProjectDevsR shr rp
|
||||
FormMissing -> do
|
||||
setMessage "Field(s) missing"
|
||||
defaultLayout $(widgetFile "project/collab/new")
|
||||
FormFailure _l -> do
|
||||
setMessage "Operation failed, see errors below"
|
||||
defaultLayout $(widgetFile "project/collab/new")
|
||||
|
||||
getProjectDevNewR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
getProjectDevNewR shr rp = do
|
||||
(pid, rid) <- runDB $ do
|
||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||
Entity r _ <- getBy404 $ UniqueProject rp s
|
||||
return (p, r)
|
||||
((_result, widget), enctype) <- runFormPost $ newProjectCollabForm pid rid
|
||||
defaultLayout $(widgetFile "project/collab/new")
|
||||
|
||||
getProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
|
||||
getProjectDevR shr rp dev = do
|
||||
rl <- runDB $ do
|
||||
rid <- do
|
||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||
Entity r _ <- getBy404 $ UniqueProject rp s
|
||||
return r
|
||||
pid <- do
|
||||
Entity s _ <- getBy404 $ UniqueSharer dev
|
||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||
return p
|
||||
Entity _cid collab <- getBy404 $ UniqueProjectCollab rid pid
|
||||
role <- getJust $ projectCollabRole collab
|
||||
return $ projectRoleIdent role
|
||||
defaultLayout $(widgetFile "project/collab/one")
|
||||
|
||||
deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
|
||||
deleteProjectDevR shr rp dev = do
|
||||
runDB $ do
|
||||
rid <- do
|
||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||
Entity r _ <- getBy404 $ UniqueProject rp s
|
||||
return r
|
||||
pid <- do
|
||||
Entity s _ <- getBy404 $ UniqueSharer dev
|
||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||
return p
|
||||
Entity cid _collab <- getBy404 $ UniqueProjectCollab rid pid
|
||||
delete cid
|
||||
setMessage "Collaborator removed."
|
||||
redirect $ ProjectDevsR shr rp
|
||||
|
||||
postProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
|
||||
postProjectDevR shr rp dev = do
|
||||
mmethod <- lookupPostParam "_method"
|
||||
case mmethod of
|
||||
Just "DELETE" -> deleteProjectDevR shr rp dev
|
||||
_ -> notFound
|
||||
|
|
|
@ -23,6 +23,15 @@ module Vervis.Handler.Role
|
|||
, getRepoRoleOpsR
|
||||
, postRepoRoleOpsR
|
||||
, getRepoRoleOpNewR
|
||||
, getProjectRolesR
|
||||
, postProjectRolesR
|
||||
, getProjectRoleNewR
|
||||
, getProjectRoleR
|
||||
, deleteProjectRoleR
|
||||
, postProjectRoleR
|
||||
, getProjectRoleOpsR
|
||||
, postProjectRoleOpsR
|
||||
, getProjectRoleOpNewR
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -135,3 +144,96 @@ getRepoRoleOpNewR rl = do
|
|||
let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl
|
||||
((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
|
||||
defaultLayout $(widgetFile "repo/role/op/new")
|
||||
|
||||
getProjectRolesR :: Handler Html
|
||||
getProjectRolesR = do
|
||||
pid <- requireAuthId
|
||||
roles <- runDB $ selectList [ProjectRolePerson ==. pid] []
|
||||
defaultLayout $(widgetFile "project/role/list")
|
||||
|
||||
postProjectRolesR :: Handler Html
|
||||
postProjectRolesR = do
|
||||
pid <- requireAuthId
|
||||
((result, widget), enctype) <- runFormPost $ newProjectRoleForm pid
|
||||
case result of
|
||||
FormSuccess npr -> do
|
||||
runDB $ do
|
||||
let role = ProjectRole
|
||||
{ projectRoleIdent = nprIdent npr
|
||||
, projectRolePerson = pid
|
||||
, projectRoleDesc = nprDesc npr
|
||||
}
|
||||
insert_ role
|
||||
redirect $ ProjectRolesR
|
||||
FormMissing -> do
|
||||
setMessage "Field(s) missing"
|
||||
defaultLayout $(widgetFile "project/role/new")
|
||||
FormFailure _l -> do
|
||||
setMessage "Invalid input, see errors below"
|
||||
defaultLayout $(widgetFile "project/role/new")
|
||||
|
||||
getProjectRoleNewR :: Handler Html
|
||||
getProjectRoleNewR = do
|
||||
pid <- requireAuthId
|
||||
((_result, widget), enctype) <- runFormPost $ newProjectRoleForm pid
|
||||
defaultLayout $(widgetFile "project/role/new")
|
||||
|
||||
getProjectRoleR :: RlIdent -> Handler Html
|
||||
getProjectRoleR rl = do
|
||||
pid <- requireAuthId
|
||||
Entity _rid role <- runDB $ getBy404 $ UniqueProjectRole pid rl
|
||||
defaultLayout $(widgetFile "project/role/one")
|
||||
|
||||
deleteProjectRoleR :: RlIdent -> Handler Html
|
||||
deleteProjectRoleR rl = do
|
||||
pid <- requireAuthId
|
||||
runDB $ do
|
||||
Entity rid _r <- getBy404 $ UniqueProjectRole pid rl
|
||||
delete rid
|
||||
setMessage "Role deleted."
|
||||
redirect ProjectRolesR
|
||||
|
||||
postProjectRoleR :: RlIdent -> Handler Html
|
||||
postProjectRoleR rl = do
|
||||
mmethod <- lookupPostParam "_method"
|
||||
case mmethod of
|
||||
Just "DELETE" -> deleteProjectRoleR rl
|
||||
_ -> notFound
|
||||
|
||||
getProjectRoleOpsR :: RlIdent -> Handler Html
|
||||
getProjectRoleOpsR rl = do
|
||||
pid <- requireAuthId
|
||||
ops <- runDB $ do
|
||||
Entity rid _r <- getBy404 $ UniqueProjectRole pid rl
|
||||
as <- selectList [ProjectAccessRole ==. rid] []
|
||||
return $ map (projectAccessOp . entityVal) as
|
||||
defaultLayout $(widgetFile "project/role/op/list")
|
||||
|
||||
postProjectRoleOpsR :: RlIdent -> Handler Html
|
||||
postProjectRoleOpsR rl = do
|
||||
pid <- requireAuthId
|
||||
let getrid = fmap entityKey $ getBy404 $ UniqueProjectRole pid rl
|
||||
((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
|
||||
case result of
|
||||
FormSuccess op -> do
|
||||
runDB $ do
|
||||
rid <- getrid
|
||||
let access = ProjectAccess
|
||||
{ projectAccessRole = rid
|
||||
, projectAccessOp = op
|
||||
}
|
||||
insert_ access
|
||||
redirect $ ProjectRoleOpsR rl
|
||||
FormMissing -> do
|
||||
setMessage "Field(s) missing"
|
||||
defaultLayout $(widgetFile "project/role/op/new")
|
||||
FormFailure _l -> do
|
||||
setMessage "Invalid input, see errors below"
|
||||
defaultLayout $(widgetFile "project/role/op/new")
|
||||
|
||||
getProjectRoleOpNewR :: RlIdent -> Handler Html
|
||||
getProjectRoleOpNewR rl = do
|
||||
pid <- requireAuthId
|
||||
let getrid = fmap entityKey $ getBy404 $ UniqueProjectRole pid rl
|
||||
((_result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
|
||||
defaultLayout $(widgetFile "project/role/op/new")
|
||||
|
|
22
templates/project/collab/list.hamlet
Normal file
22
templates/project/collab/list.hamlet
Normal file
|
@ -0,0 +1,22 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ 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
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<th>Collaborator
|
||||
<th>Role
|
||||
$forall (Entity _sid sharer, Value rl) <- devs
|
||||
<tr>
|
||||
<td>^{personLinkW sharer}
|
||||
<td>#{rl2text rl}
|
17
templates/project/collab/new.hamlet
Normal file
17
templates/project/collab/new.hamlet
Normal file
|
@ -0,0 +1,17 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ 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
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<form method=POST action=@{ProjectDevsR shr rp} enctype=#{enctype}>
|
||||
^{widget}
|
||||
<input type=submit>
|
16
templates/project/collab/one.hamlet
Normal file
16
templates/project/collab/one.hamlet
Normal file
|
@ -0,0 +1,16 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ 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
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<p>
|
||||
Role: #{rl2text rl}
|
19
templates/project/role/list.hamlet
Normal file
19
templates/project/role/list.hamlet
Normal file
|
@ -0,0 +1,19 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ 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
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<ul>
|
||||
$forall Entity _rid role <- roles
|
||||
<li>
|
||||
<a href=@{ProjectRoleR $ projectRoleIdent role}>
|
||||
#{rl2text $ projectRoleIdent role}
|
17
templates/project/role/new.hamlet
Normal file
17
templates/project/role/new.hamlet
Normal file
|
@ -0,0 +1,17 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ 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
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<form method=POST action=@{ProjectRolesR} enctype=#{enctype}>
|
||||
^{widget}
|
||||
<input type=submit>
|
24
templates/project/role/one.hamlet
Normal file
24
templates/project/role/one.hamlet
Normal file
|
@ -0,0 +1,24 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ 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
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<div>
|
||||
<form method=POST action=@{ProjectRoleR rl}>
|
||||
<input type=hidden name=_method value=DELETE>
|
||||
<input type=submit value="Delete this role">
|
||||
|
||||
<p>
|
||||
<a href=@{ProjectRoleOpsR rl}>Operations
|
||||
|
||||
<p>
|
||||
#{projectRoleDesc role}
|
18
templates/project/role/op/list.hamlet
Normal file
18
templates/project/role/op/list.hamlet
Normal file
|
@ -0,0 +1,18 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ 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
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<ul>
|
||||
$forall op <- ops
|
||||
<li>
|
||||
#{show op}
|
17
templates/project/role/op/new.hamlet
Normal file
17
templates/project/role/op/new.hamlet
Normal file
|
@ -0,0 +1,17 @@
|
|||
$# This file is part of Vervis.
|
||||
$#
|
||||
$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
$#
|
||||
$# ♡ 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
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<form method=POST action=@{ProjectRoleOpsR rl} enctype=#{enctype}>
|
||||
^{widget}
|
||||
<input type=submit>
|
Loading…
Reference in a new issue