mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-29 02:24: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
|
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
|
-- Projects
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
|
@ -56,6 +56,12 @@
|
||||||
/rr/#RlIdent/a RepoRoleOpsR GET POST
|
/rr/#RlIdent/a RepoRoleOpsR GET POST
|
||||||
/rr/#RlIdent/a/!new RepoRoleOpNewR GET
|
/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
|
-- Projects
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
|
@ -78,6 +84,9 @@
|
||||||
/s/#ShrIdent/p ProjectsR GET POST
|
/s/#ShrIdent/p ProjectsR GET POST
|
||||||
/s/#ShrIdent/p/!new ProjectNewR GET
|
/s/#ShrIdent/p/!new ProjectNewR GET
|
||||||
/s/#ShrIdent/p/#PrjIdent ProjectR 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 TicketsR GET POST
|
||||||
/s/#ShrIdent/p/#PrjIdent/t/!new TicketNewR GET
|
/s/#ShrIdent/p/#PrjIdent/t/!new TicketNewR GET
|
||||||
|
|
|
@ -16,6 +16,8 @@
|
||||||
module Vervis.Field.Role
|
module Vervis.Field.Role
|
||||||
( newRepoRoleIdentField
|
( newRepoRoleIdentField
|
||||||
, newRepoOpField
|
, newRepoOpField
|
||||||
|
, newProjectRoleIdentField
|
||||||
|
, newProjectOpField
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -40,12 +42,12 @@ import Vervis.Model
|
||||||
import Vervis.Model.Ident (RlIdent, rl2text, text2rl)
|
import Vervis.Model.Ident (RlIdent, rl2text, text2rl)
|
||||||
import Vervis.Model.Role
|
import Vervis.Model.Role
|
||||||
|
|
||||||
|
roleIdentField :: Field Handler RlIdent
|
||||||
|
roleIdentField = convertField text2rl rl2text textField
|
||||||
|
|
||||||
newRepoRoleIdentField :: PersonId -> Field Handler RlIdent
|
newRepoRoleIdentField :: PersonId -> Field Handler RlIdent
|
||||||
newRepoRoleIdentField pid = checkUniqueCI pid roleIdentField
|
newRepoRoleIdentField pid = checkUniqueCI pid roleIdentField
|
||||||
where
|
where
|
||||||
roleIdentField :: Field Handler RlIdent
|
|
||||||
roleIdentField = convertField text2rl rl2text textField
|
|
||||||
|
|
||||||
checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
|
checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
|
||||||
checkUniqueCI pid = checkM $ \ rl -> do
|
checkUniqueCI pid = checkM $ \ rl -> do
|
||||||
sames <- runDB $ select $ from $ \ role -> do
|
sames <- runDB $ select $ from $ \ role -> do
|
||||||
|
@ -75,3 +77,36 @@ newRepoOpField getrid = checkOpNew getrid opField
|
||||||
return $ case ma of
|
return $ case ma of
|
||||||
Nothing -> Right op
|
Nothing -> Right op
|
||||||
Just _ -> Left ("Role already has this operation" :: Text)
|
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
|
module Vervis.Form.Project
|
||||||
( newProjectForm
|
( newProjectForm
|
||||||
|
, NewProjectCollab (..)
|
||||||
|
, newProjectCollabForm
|
||||||
)
|
)
|
||||||
where
|
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.Field.Project
|
||||||
import Vervis.Model.Ident (text2prj)
|
import Vervis.Model
|
||||||
|
import Vervis.Model.Ident
|
||||||
|
import Vervis.Model.Repo
|
||||||
|
|
||||||
newProjectAForm :: SharerId -> AForm Handler Project
|
newProjectAForm :: SharerId -> AForm Handler Project
|
||||||
newProjectAForm sid = Project
|
newProjectAForm sid = Project
|
||||||
|
@ -33,3 +41,32 @@ newProjectAForm sid = Project
|
||||||
|
|
||||||
newProjectForm :: SharerId -> Form Project
|
newProjectForm :: SharerId -> Form Project
|
||||||
newProjectForm = renderDivs . newProjectAForm
|
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 (..)
|
( NewRepoRole (..)
|
||||||
, newRepoRoleForm
|
, newRepoRoleForm
|
||||||
, newRepoRoleOpForm
|
, newRepoRoleOpForm
|
||||||
|
, NewProjectRole (..)
|
||||||
|
, newProjectRoleForm
|
||||||
|
, newProjectRoleOpForm
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -51,3 +54,23 @@ newRepoRoleOpAForm getrid = areq (newRepoOpField getrid) "Operation*" Nothing
|
||||||
|
|
||||||
newRepoRoleOpForm :: AppDB RepoRoleId -> Form RepoOperation
|
newRepoRoleOpForm :: AppDB RepoRoleId -> Form RepoOperation
|
||||||
newRepoRoleOpForm getrid = renderDivs $ newRepoRoleOpAForm getrid
|
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
|
(RepoRoleOpsR _rl , _ ) -> personAny
|
||||||
(RepoRoleOpNewR _rl , _ ) -> personAny
|
(RepoRoleOpNewR _rl , _ ) -> personAny
|
||||||
|
|
||||||
|
(ProjectRolesR , _ ) -> personAny
|
||||||
|
(ProjectRoleNewR , _ ) -> personAny
|
||||||
|
(ProjectRoleR _rl , _ ) -> personAny
|
||||||
|
(ProjectRoleOpsR _rl , _ ) -> personAny
|
||||||
|
(ProjectRoleOpNewR _rl , _ ) -> personAny
|
||||||
|
|
||||||
(ReposR shar , True) -> person shar
|
(ReposR shar , True) -> person shar
|
||||||
(RepoNewR user , _ ) -> person user
|
(RepoNewR user , _ ) -> person user
|
||||||
(RepoR shar _ , True) -> person shar
|
(RepoR shar _ , True) -> person shar
|
||||||
|
@ -144,6 +150,9 @@ instance Yesod App where
|
||||||
|
|
||||||
(ProjectsR shar , True) -> person shar
|
(ProjectsR shar , True) -> person shar
|
||||||
(ProjectNewR user , _ ) -> person user
|
(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
|
(TicketsR shar _ , True) -> person shar
|
||||||
(TicketNewR _ _ , _ ) -> personAny
|
(TicketNewR _ _ , _ ) -> personAny
|
||||||
|
@ -307,6 +316,12 @@ instance YesodBreadcrumbs App where
|
||||||
RepoRoleOpsR rl -> ("Operations", Just $ RepoRoleR rl)
|
RepoRoleOpsR rl -> ("Operations", Just $ RepoRoleR rl)
|
||||||
RepoRoleOpNewR rl -> ("New", Just $ RepoRoleOpsR 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)
|
ReposR shar -> ("Repos", Just $ PersonR shar)
|
||||||
RepoNewR shar -> ("New", Just $ ReposR shar)
|
RepoNewR shar -> ("New", Just $ ReposR shar)
|
||||||
RepoR shar repo -> (rp2text repo, Just $ ReposR shar)
|
RepoR shar repo -> (rp2text repo, Just $ ReposR shar)
|
||||||
|
@ -320,7 +335,9 @@ instance YesodBreadcrumbs App where
|
||||||
RepoChangesR shar repo ref -> ( ref
|
RepoChangesR shar repo ref -> ( ref
|
||||||
, Just $ RepoHeadChangesR shar repo
|
, 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)
|
RepoDevNewR shr rp -> ("New", Just $ RepoDevsR shr rp)
|
||||||
RepoDevR shr rp dev -> ( shr2text dev
|
RepoDevR shr rp dev -> ( shr2text dev
|
||||||
, Just $ RepoDevsR shr rp
|
, Just $ RepoDevsR shr rp
|
||||||
|
@ -335,6 +352,15 @@ instance YesodBreadcrumbs App where
|
||||||
ProjectR shar proj -> ( prj2text proj
|
ProjectR shar proj -> ( prj2text proj
|
||||||
, Just $ ProjectsR shar
|
, 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"
|
TicketsR shar proj -> ( "Tickets"
|
||||||
, Just $ ProjectR shar proj
|
, Just $ ProjectR shar proj
|
||||||
|
|
|
@ -18,6 +18,12 @@ module Vervis.Handler.Project
|
||||||
, postProjectsR
|
, postProjectsR
|
||||||
, getProjectNewR
|
, getProjectNewR
|
||||||
, getProjectR
|
, getProjectR
|
||||||
|
, getProjectDevsR
|
||||||
|
, postProjectDevsR
|
||||||
|
, getProjectDevNewR
|
||||||
|
, getProjectDevR
|
||||||
|
, deleteProjectDevR
|
||||||
|
, postProjectDevR
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -26,10 +32,11 @@ import Prelude
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
|
import Database.Esqueleto hiding (delete, (%), (==.))
|
||||||
import Text.Blaze.Html (Html)
|
import Text.Blaze.Html (Html)
|
||||||
import Yesod.Auth (requireAuth)
|
import Yesod.Auth (requireAuth)
|
||||||
import Yesod.Core (defaultLayout)
|
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.Functions (runFormPost)
|
||||||
import Yesod.Form.Types (FormResult (..))
|
import Yesod.Form.Types (FormResult (..))
|
||||||
import Yesod.Persist.Core (runDB, getBy404)
|
import Yesod.Persist.Core (runDB, getBy404)
|
||||||
|
@ -42,15 +49,16 @@ import Vervis.Model
|
||||||
import Vervis.Model.Ident
|
import Vervis.Model.Ident
|
||||||
import Vervis.Model.Repo
|
import Vervis.Model.Repo
|
||||||
import Vervis.Settings
|
import Vervis.Settings
|
||||||
|
import Vervis.Widget.Sharer
|
||||||
|
|
||||||
getProjectsR :: ShrIdent -> Handler Html
|
getProjectsR :: ShrIdent -> Handler Html
|
||||||
getProjectsR ident = do
|
getProjectsR ident = do
|
||||||
projects <- runDB $ E.select $ E.from $ \ (sharer, project) -> do
|
projects <- runDB $ select $ from $ \ (sharer, project) -> do
|
||||||
E.where_ $
|
where_ $
|
||||||
sharer E.^. SharerIdent E.==. E.val ident E.&&.
|
sharer ^. SharerIdent E.==. val ident &&.
|
||||||
sharer E.^. SharerId E.==. project E.^. ProjectSharer
|
sharer ^. SharerId E.==. project ^. ProjectSharer
|
||||||
E.orderBy [E.asc $ project E.^. ProjectIdent]
|
orderBy [asc $ project ^. ProjectIdent]
|
||||||
return $ project E.^. ProjectIdent
|
return $ project ^. ProjectIdent
|
||||||
defaultLayout $(widgetFile "project/list")
|
defaultLayout $(widgetFile "project/list")
|
||||||
|
|
||||||
postProjectsR :: ShrIdent -> Handler Html
|
postProjectsR :: ShrIdent -> Handler Html
|
||||||
|
@ -85,3 +93,94 @@ getProjectR shar proj = do
|
||||||
rs <- selectList [RepoProject ==. Just pid] [Asc RepoIdent]
|
rs <- selectList [RepoProject ==. Just pid] [Asc RepoIdent]
|
||||||
return (p, rs)
|
return (p, rs)
|
||||||
defaultLayout $(widgetFile "project/one")
|
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
|
, getRepoRoleOpsR
|
||||||
, postRepoRoleOpsR
|
, postRepoRoleOpsR
|
||||||
, getRepoRoleOpNewR
|
, getRepoRoleOpNewR
|
||||||
|
, getProjectRolesR
|
||||||
|
, postProjectRolesR
|
||||||
|
, getProjectRoleNewR
|
||||||
|
, getProjectRoleR
|
||||||
|
, deleteProjectRoleR
|
||||||
|
, postProjectRoleR
|
||||||
|
, getProjectRoleOpsR
|
||||||
|
, postProjectRoleOpsR
|
||||||
|
, getProjectRoleOpNewR
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -135,3 +144,96 @@ getRepoRoleOpNewR rl = do
|
||||||
let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl
|
let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl
|
||||||
((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
|
((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
|
||||||
defaultLayout $(widgetFile "repo/role/op/new")
|
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