forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Roles now under by sharers, i.e. now groups too

Browse source
This commit is contained in:
fr33domlover 2016-06-06 17:29:54 +00:00
parent 05e0d837fa
commit f2e4bb4291
10 changed files with 127 additions and 119 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
config/models
View file

@ -55,10 +55,10 @@ GroupMember
RepoRole
ident RlIdent
person PersonId
sharer SharerId
desc Text
UniqueRepoRole person ident
UniqueRepoRole sharer ident
RepoAccess
role RepoRoleId
@ -75,10 +75,10 @@ RepoCollab
ProjectRole
ident RlIdent
person PersonId
sharer SharerId
desc Text
UniqueProjectRole person ident
UniqueProjectRole sharer ident
ProjectAccess
role ProjectRoleId

8
src/Vervis/Field/Project.hs
View file

@ -39,15 +39,15 @@ checkTemplate =
in checkBool identOk msg
checkUniqueCI :: SharerId -> Field Handler PrjIdent -> Field Handler PrjIdent
checkUniqueCI sid = checkM $ \ ident -> do
checkUniqueCI sid = checkM $ \ prj -> do
sames <- runDB $ select $ from $ \ project -> do
where_ $
project ^. ProjectSharer ==. val sid &&.
lower_ (project ^. ProjectIdent) ==. lower_ (val ident)
project ^. ProjectSharer ==. val sid &&.
lower_ (project ^. ProjectIdent) ==. lower_ (val prj)
limit 1
return ()
return $ if null sames
then Right ident
then Right prj
else Left ("You already have a project by that name" :: Text)
projectIdentField :: Field Handler PrjIdent

27
src/Vervis/Field/Role.hs
View file

@ -23,10 +23,6 @@ where
import Prelude
-- import Control.Monad (void)
-- import Control.Monad.Trans.Maybe
-- import Data.Char (isDigit)
-- import Data.Maybe (isNothing, isJust)
import Data.Text (Text)
import Database.Esqueleto
import Yesod.Form.Fields (textField, selectField, optionsEnum)
@ -34,9 +30,6 @@ import Yesod.Form.Functions (checkM, convertField)
import Yesod.Form.Types (Field)
import Yesod.Persist.Core (runDB)
-- import qualified Data.Text as T (null, all, find, split)
-- import Data.Char.Local (isAsciiLetter)
import Vervis.Foundation (Handler, AppDB)
import Vervis.Model
import Vervis.Model.Ident (RlIdent, rl2text, text2rl)
@ -45,14 +38,14 @@ import Vervis.Model.Role
roleIdentField :: Field Handler RlIdent
roleIdentField = convertField text2rl rl2text textField
newRepoRoleIdentField :: PersonId -> Field Handler RlIdent
newRepoRoleIdentField pid = checkUniqueCI pid roleIdentField
newRepoRoleIdentField :: SharerId -> Field Handler RlIdent
newRepoRoleIdentField sid = checkUniqueCI roleIdentField
where
checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
checkUniqueCI pid = checkM $ \ rl -> do
checkUniqueCI :: Field Handler RlIdent -> Field Handler RlIdent
checkUniqueCI = checkM $ \ rl -> do
sames <- runDB $ select $ from $ \ role -> do
where_ $
role ^. RepoRolePerson ==. val pid &&.
role ^. RepoRoleSharer ==. val sid &&.
lower_ (role ^. RepoRoleIdent) ==. lower_ (val rl)
limit 1
return ()
@ -78,14 +71,14 @@ newRepoOpField getrid = checkOpNew getrid opField
Nothing -> Right op
Just _ -> Left ("Role already has this operation" :: Text)
newProjectRoleIdentField :: PersonId -> Field Handler RlIdent
newProjectRoleIdentField pid = checkUniqueCI pid roleIdentField
newProjectRoleIdentField :: SharerId -> Field Handler RlIdent
newProjectRoleIdentField sid = checkUniqueCI roleIdentField
where
checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
checkUniqueCI pid = checkM $ \ rl -> do
checkUniqueCI :: Field Handler RlIdent -> Field Handler RlIdent
checkUniqueCI = checkM $ \ rl -> do
sames <- runDB $ select $ from $ \ role -> do
where_ $
role ^. ProjectRolePerson ==. val pid &&.
role ^. ProjectRoleSharer ==. val sid &&.
lower_ (role ^. ProjectRoleIdent) ==. lower_ (val rl)
limit 1
return ()

34
src/Vervis/Form/Project.hs
View file

@ -40,8 +40,8 @@ data NewProject = NewProject
, npRole :: ProjectRoleId
}
newProjectAForm :: PersonId -> SharerId -> AForm Handler NewProject
newProjectAForm pid sid = NewProject
newProjectAForm :: SharerId -> AForm Handler NewProject
newProjectAForm sid = NewProject
<$> areq (newProjectIdentField sid) "Identifier*" Nothing
<*> aopt textField "Name" Nothing
<*> aopt textField "Description" Nothing
@ -49,11 +49,11 @@ newProjectAForm pid sid = NewProject
where
selectRole =
selectField $
optionsPersistKey [ProjectRolePerson ==. pid] [] $
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
rl2text . projectRoleIdent
newProjectForm :: PersonId -> SharerId -> Form NewProject
newProjectForm pid sid = renderDivs $ newProjectAForm pid sid
newProjectForm :: SharerId -> Form NewProject
newProjectForm sid = renderDivs $ newProjectAForm sid
data NewProjectCollab = NewProjectCollab
{ ncPerson :: PersonId
@ -61,8 +61,8 @@ data NewProjectCollab = NewProjectCollab
}
newProjectCollabAForm
:: PersonId -> ProjectId -> AForm Handler NewProjectCollab
newProjectCollabAForm pid rid = NewProjectCollab
:: SharerId -> ProjectId -> AForm Handler NewProjectCollab
newProjectCollabAForm sid jid = NewProjectCollab
<$> areq selectPerson "Person*" Nothing
<*> areq selectRole "Role*" Nothing
where
@ -71,27 +71,27 @@ newProjectCollabAForm pid rid = NewProjectCollab
from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
on $ person ^. PersonIdent E.==. sharer ^. SharerId
on $
collab ?. ProjectCollabProject E.==. just (val rid) &&.
collab ?. ProjectCollabProject E.==. just (val jid) &&.
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] [] $
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
rl2text . projectRoleIdent
newProjectCollabForm :: PersonId -> ProjectId -> Form NewProjectCollab
newProjectCollabForm pid rid = renderDivs $ newProjectCollabAForm pid rid
newProjectCollabForm :: SharerId -> ProjectId -> Form NewProjectCollab
newProjectCollabForm sid jid = renderDivs $ newProjectCollabAForm sid jid
editProjectAForm :: Entity Project -> AForm Handler Project
editProjectAForm (Entity jid project) = Project
<$> pure (projectIdent project)
<*> pure (projectSharer project)
<*> aopt textField "Name" (Just $ projectName project)
<*> aopt textField "Description" (Just $ projectDesc project)
<*> pure (projectNextTicket project)
<*> aopt selectWiki "Wiki" (Just $ projectWiki project)
<$> pure (projectIdent project)
<*> pure (projectSharer project)
<*> aopt textField "Name" (Just $ projectName project)
<*> aopt textField "Description" (Just $ projectDesc project)
<*> pure (projectNextTicket project)
<*> aopt selectWiki "Wiki" (Just $ projectWiki project)
where
selectWiki =
selectField $

23
src/Vervis/Form/Repo.hs
View file

@ -42,12 +42,11 @@ data NewRepo = NewRepo
, nrpRole :: RepoRoleId
}
newRepoAForm
:: PersonId -> SharerId -> Maybe ProjectId -> AForm Handler NewRepo
newRepoAForm pid sid mpid = NewRepo
newRepoAForm :: SharerId -> Maybe ProjectId -> AForm Handler NewRepo
newRepoAForm sid mjid = NewRepo
<$> (text2rp <$> areq (mkIdentField sid) "Identifier*" Nothing)
<*> areq (selectFieldList vcsList) "Version control system*" Nothing
<*> aopt (selectProjectForNew sid) "Project" (Just mpid)
<*> aopt (selectProjectForNew sid) "Project" (Just mjid)
<*> aopt textField "Description" Nothing
<*> areq selectRole "Your role*" Nothing
where
@ -58,11 +57,11 @@ newRepoAForm pid sid mpid = NewRepo
]
selectRole =
selectField $
optionsPersistKey [RepoRolePerson ==. pid] [] $
optionsPersistKey [RepoRoleSharer ==. sid] [] $
rl2text . repoRoleIdent
newRepoForm :: PersonId -> SharerId -> Maybe ProjectId -> Form NewRepo
newRepoForm pid sid mpid = renderDivs $ newRepoAForm pid sid mpid
newRepoForm :: SharerId -> Maybe ProjectId -> Form NewRepo
newRepoForm sid mjid = renderDivs $ newRepoAForm sid mjid
data NewRepoCollab = NewRepoCollab
{ ncPerson :: PersonId
@ -70,8 +69,8 @@ data NewRepoCollab = NewRepoCollab
}
newRepoCollabAForm
:: PersonId -> Maybe ProjectId -> RepoId -> AForm Handler NewRepoCollab
newRepoCollabAForm pid mjid rid = NewRepoCollab
:: SharerId -> Maybe ProjectId -> RepoId -> AForm Handler NewRepoCollab
newRepoCollabAForm sid mjid rid = NewRepoCollab
<$> areq (selectPerson mjid) "Person*" Nothing
<*> areq selectRole "Role*" Nothing
where
@ -79,12 +78,12 @@ newRepoCollabAForm pid mjid rid = NewRepoCollab
selectPerson (Just jid) = selectCollabFromProject jid rid
selectRole =
selectField $
optionsPersistKey [RepoRolePerson ==. pid] [] $
optionsPersistKey [RepoRoleSharer ==. sid] [] $
rl2text . repoRoleIdent
newRepoCollabForm
:: PersonId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab
newRepoCollabForm pid mjid rid = renderDivs $ newRepoCollabAForm pid mjid rid
:: SharerId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab
newRepoCollabForm sid mjid rid = renderDivs $ newRepoCollabAForm sid mjid rid
editRepoAForm :: Entity Repo -> AForm Handler Repo
editRepoAForm (Entity rid repo) = Repo

20
src/Vervis/Form/Role.hs
View file

@ -41,13 +41,13 @@ data NewRepoRole = NewRepoRole
, nrrDesc :: Text
}
newRepoRoleAForm :: PersonId -> AForm Handler NewRepoRole
newRepoRoleAForm pid = NewRepoRole
<$> areq (newRepoRoleIdentField pid) "Name*" Nothing
newRepoRoleAForm :: SharerId -> AForm Handler NewRepoRole
newRepoRoleAForm sid = NewRepoRole
<$> areq (newRepoRoleIdentField sid) "Name*" Nothing
<*> areq textField "Description" Nothing
newRepoRoleForm :: PersonId -> Form NewRepoRole
newRepoRoleForm pid = renderDivs $ newRepoRoleAForm pid
newRepoRoleForm :: SharerId -> Form NewRepoRole
newRepoRoleForm sid = renderDivs $ newRepoRoleAForm sid
newRepoRoleOpAForm :: AppDB RepoRoleId -> AForm Handler RepoOperation
newRepoRoleOpAForm getrid = areq (newRepoOpField getrid) "Operation*" Nothing
@ -60,13 +60,13 @@ data NewProjectRole = NewProjectRole
, nprDesc :: Text
}
newProjectRoleAForm :: PersonId -> AForm Handler NewProjectRole
newProjectRoleAForm pid = NewProjectRole
<$> areq (newProjectRoleIdentField pid) "Name*" Nothing
newProjectRoleAForm :: SharerId -> AForm Handler NewProjectRole
newProjectRoleAForm sid = NewProjectRole
<$> areq (newProjectRoleIdentField sid) "Name*" Nothing
<*> areq textField "Description" Nothing
newProjectRoleForm :: PersonId -> Form NewProjectRole
newProjectRoleForm pid = renderDivs $ newProjectRoleAForm pid
newProjectRoleForm :: SharerId -> Form NewProjectRole
newProjectRoleForm sid = renderDivs $ newProjectRoleAForm sid
newProjectRoleOpAForm :: AppDB ProjectRoleId -> AForm Handler ProjectOperation
newProjectRoleOpAForm getrid =

43
src/Vervis/Handler/Project.hs
View file

@ -66,11 +66,11 @@ getProjectsR ident = do
postProjectsR :: ShrIdent -> Handler Html
postProjectsR shr = do
pid <- requireAuthId
Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
((result, widget), enctype) <- runFormPost $ newProjectForm pid sid
((result, widget), enctype) <- runFormPost $ newProjectForm sid
case result of
FormSuccess np -> do
pid <- requireAuthId
runDB $ do
let project = Project
{ projectIdent = npIdent np
@ -98,9 +98,8 @@ postProjectsR shr = do
getProjectNewR :: ShrIdent -> Handler Html
getProjectNewR shr = do
pid <- requireAuthId
Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
((_result, widget), enctype) <- runFormPost $ newProjectForm pid sid
((_result, widget), enctype) <- runFormPost $ newProjectForm sid
defaultLayout $(widgetFile "project/new")
getProjectR :: ShrIdent -> PrjIdent -> Handler Html
@ -163,17 +162,16 @@ getProjectDevsR shr rp = do
postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
postProjectDevsR shr rp = do
(pid, rid) <- runDB $ do
(sid, jid) <- 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
Entity j _ <- getBy404 $ UniqueProject rp s
return (s, j)
((result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid
case result of
FormSuccess nc -> do
runDB $ do
let collab = ProjectCollab
{ projectCollabProject = rid
{ projectCollabProject = jid
, projectCollabPerson = ncPerson nc
, projectCollabRole = ncRole nc
}
@ -189,26 +187,25 @@ postProjectDevsR shr rp = do
getProjectDevNewR :: ShrIdent -> PrjIdent -> Handler Html
getProjectDevNewR shr rp = do
(pid, rid) <- runDB $ do
(sid, jid) <- 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
Entity j _ <- getBy404 $ UniqueProject rp s
return (s, j)
((_result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid
defaultLayout $(widgetFile "project/collab/new")
getProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
getProjectDevR shr rp dev = do
rl <- runDB $ do
rid <- do
jid <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity r _ <- getBy404 $ UniqueProject rp s
return r
Entity j _ <- getBy404 $ UniqueProject rp s
return j
pid <- do
Entity s _ <- getBy404 $ UniqueSharer dev
Entity p _ <- getBy404 $ UniquePersonIdent s
return p
Entity _cid collab <- getBy404 $ UniqueProjectCollab rid pid
Entity _cid collab <- getBy404 $ UniqueProjectCollab jid pid
role <- getJust $ projectCollabRole collab
return $ projectRoleIdent role
defaultLayout $(widgetFile "project/collab/one")
@ -216,15 +213,15 @@ getProjectDevR shr rp dev = do
deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
deleteProjectDevR shr rp dev = do
runDB $ do
rid <- do
jid <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity r _ <- getBy404 $ UniqueProject rp s
return r
Entity j _ <- getBy404 $ UniqueProject rp s
return j
pid <- do
Entity s _ <- getBy404 $ UniqueSharer dev
Entity p _ <- getBy404 $ UniquePersonIdent s
return p
Entity cid _collab <- getBy404 $ UniqueProjectCollab rid pid
Entity cid _collab <- getBy404 $ UniqueProjectCollab jid pid
delete cid
setMessage "Collaborator removed."
redirect $ ProjectDevsR shr rp

21
src/Vervis/Handler/Repo.hs
View file

@ -113,9 +113,8 @@ getReposR user = do
postReposR :: ShrIdent -> Handler Html
postReposR user = do
Entity pid person <- requireAuth
Entity sid _sharer <- runDB $ getBy404 $ UniqueSharer user
((result, widget), enctype) <- runFormPost $ newRepoForm pid sid Nothing
((result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing
case result of
FormSuccess nrp -> do
parent <- askSharerDir user
@ -126,6 +125,7 @@ postReposR user = do
case nrpVcs nrp of
VCSDarcs -> D.createRepo parent repoName
VCSGit -> G.createRepo parent repoName
Entity pid person <- requireAuth
runDB $ do
let repo = Repo
{ repoIdent = nrpIdent nrp
@ -153,9 +153,8 @@ postReposR user = do
getRepoNewR :: ShrIdent -> Handler Html
getRepoNewR user = do
Entity pid person <- requireAuth
Entity sid _sharer <- runDB $ getBy404 $ UniqueSharer user
((_result, widget), enctype) <- runFormPost $ newRepoForm pid sid Nothing
((_result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing
defaultLayout $(widgetFile "repo/new")
selectRepo :: ShrIdent -> RpIdent -> AppDB Repo
@ -278,12 +277,11 @@ getRepoDevsR shr rp = do
postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
postRepoDevsR shr rp = do
(pid, mjid, rid) <- runDB $ do
(sid, mjid, rid) <- runDB $ do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniquePersonIdent s
Entity r repository <- getBy404 $ UniqueRepo rp s
return (p, repoProject repository, r)
((result, widget), enctype) <- runFormPost $ newRepoCollabForm pid mjid rid
return (s, repoProject repository, r)
((result, widget), enctype) <- runFormPost $ newRepoCollabForm sid mjid rid
case result of
FormSuccess nc -> do
runDB $ do
@ -304,13 +302,12 @@ postRepoDevsR shr rp = do
getRepoDevNewR :: ShrIdent -> RpIdent -> Handler Html
getRepoDevNewR shr rp = do
(pid, mjid, rid) <- runDB $ do
(sid, mjid, rid) <- runDB $ do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniquePersonIdent s
Entity r repository <- getBy404 $ UniqueRepo rp s
return (p, repoProject repository, r)
return (s, repoProject repository, r)
((_result, widget), enctype) <-
runFormPost $ newRepoCollabForm pid mjid rid
runFormPost $ newRepoCollabForm sid mjid rid
defaultLayout $(widgetFile "repo/collab/new")
getRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html

60
src/Vervis/Handler/Role.hs
View file

@ -55,19 +55,22 @@ import Vervis.Settings (widgetFile)
getRepoRolesR :: Handler Html
getRepoRolesR = do
pid <- requireAuthId
roles <- runDB $ selectList [RepoRolePerson ==. pid] []
roles <- runDB $ do
person <- getJust pid
selectList [RepoRoleSharer ==. personIdent person] []
defaultLayout $(widgetFile "repo/role/list")
postRepoRolesR :: Handler Html
postRepoRolesR = do
pid <- requireAuthId
((result, widget), enctype) <- runFormPost $ newRepoRoleForm pid
sid <- fmap personIdent $ runDB $ getJust pid
((result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
case result of
FormSuccess nrr -> do
runDB $ do
let role = RepoRole
{ repoRoleIdent = nrrIdent nrr
, repoRolePerson = pid
, repoRoleSharer = sid
, repoRoleDesc = nrrDesc nrr
}
insert_ role
@ -82,20 +85,24 @@ postRepoRolesR = do
getRepoRoleNewR :: Handler Html
getRepoRoleNewR = do
pid <- requireAuthId
((_result, widget), enctype) <- runFormPost $ newRepoRoleForm pid
sid <- fmap personIdent $ runDB $ getJust pid
((_result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
defaultLayout $(widgetFile "repo/role/new")
getRepoRoleR :: RlIdent -> Handler Html
getRepoRoleR rl = do
pid <- requireAuthId
Entity _rid role <- runDB $ getBy404 $ UniqueRepoRole pid rl
sid <- fmap personIdent $ runDB $ getJust pid
Entity _rid role <- runDB $ getBy404 $ UniqueRepoRole sid rl
defaultLayout $(widgetFile "repo/role/one")
deleteRepoRoleR :: RlIdent -> Handler Html
deleteRepoRoleR rl = do
pid <- requireAuthId
runDB $ do
Entity rid _r <- getBy404 $ UniqueRepoRole pid rl
person <- getJust pid
let sid = personIdent person
Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
delete rid
setMessage "Role deleted."
redirect RepoRolesR
@ -111,7 +118,8 @@ getRepoRoleOpsR :: RlIdent -> Handler Html
getRepoRoleOpsR rl = do
pid <- requireAuthId
ops <- runDB $ do
Entity rid _r <- getBy404 $ UniqueRepoRole pid rl
sid <- personIdent <$> getJust pid
Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
as <- selectList [RepoAccessRole ==. rid] []
return $ map (repoAccessOp . entityVal) as
defaultLayout $(widgetFile "repo/role/op/list")
@ -119,7 +127,9 @@ getRepoRoleOpsR rl = do
postRepoRoleOpsR :: RlIdent -> Handler Html
postRepoRoleOpsR rl = do
pid <- requireAuthId
let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl
let getrid = do
sid <- personIdent <$> getJust pid
fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
((result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
case result of
FormSuccess op -> do
@ -141,26 +151,31 @@ postRepoRoleOpsR rl = do
getRepoRoleOpNewR :: RlIdent -> Handler Html
getRepoRoleOpNewR rl = do
pid <- requireAuthId
let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl
let getrid = do
sid <- personIdent <$> getJust pid
fmap entityKey $ getBy404 $ UniqueRepoRole sid 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] []
roles <- runDB $ do
person <- getJust pid
selectList [ProjectRoleSharer ==. personIdent person] []
defaultLayout $(widgetFile "project/role/list")
postProjectRolesR :: Handler Html
postProjectRolesR = do
pid <- requireAuthId
((result, widget), enctype) <- runFormPost $ newProjectRoleForm pid
sid <- fmap personIdent $ runDB $ getJust pid
((result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
case result of
FormSuccess npr -> do
runDB $ do
let role = ProjectRole
{ projectRoleIdent = nprIdent npr
, projectRolePerson = pid
, projectRoleSharer = sid
, projectRoleDesc = nprDesc npr
}
insert_ role
@ -175,20 +190,24 @@ postProjectRolesR = do
getProjectRoleNewR :: Handler Html
getProjectRoleNewR = do
pid <- requireAuthId
((_result, widget), enctype) <- runFormPost $ newProjectRoleForm pid
sid <- fmap personIdent $ runDB $ getJust pid
((_result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
defaultLayout $(widgetFile "project/role/new")
getProjectRoleR :: RlIdent -> Handler Html
getProjectRoleR rl = do
pid <- requireAuthId
Entity _rid role <- runDB $ getBy404 $ UniqueProjectRole pid rl
Entity _rid role <- runDB $ do
sid <- personIdent <$> getJust pid
getBy404 $ UniqueProjectRole sid rl
defaultLayout $(widgetFile "project/role/one")
deleteProjectRoleR :: RlIdent -> Handler Html
deleteProjectRoleR rl = do
pid <- requireAuthId
runDB $ do
Entity rid _r <- getBy404 $ UniqueProjectRole pid rl
sid <- personIdent <$> getJust pid
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
delete rid
setMessage "Role deleted."
redirect ProjectRolesR
@ -204,7 +223,8 @@ getProjectRoleOpsR :: RlIdent -> Handler Html
getProjectRoleOpsR rl = do
pid <- requireAuthId
ops <- runDB $ do
Entity rid _r <- getBy404 $ UniqueProjectRole pid rl
sid <- personIdent <$> getJust pid
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
as <- selectList [ProjectAccessRole ==. rid] []
return $ map (projectAccessOp . entityVal) as
defaultLayout $(widgetFile "project/role/op/list")
@ -212,7 +232,9 @@ getProjectRoleOpsR rl = do
postProjectRoleOpsR :: RlIdent -> Handler Html
postProjectRoleOpsR rl = do
pid <- requireAuthId
let getrid = fmap entityKey $ getBy404 $ UniqueProjectRole pid rl
let getrid = do
sid <- personIdent <$> getJust pid
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
case result of
FormSuccess op -> do
@ -234,6 +256,8 @@ postProjectRoleOpsR rl = do
getProjectRoleOpNewR :: RlIdent -> Handler Html
getProjectRoleOpNewR rl = do
pid <- requireAuthId
let getrid = fmap entityKey $ getBy404 $ UniqueProjectRole pid rl
let getrid = do
sid <- personIdent <$> getJust pid
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
((_result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
defaultLayout $(widgetFile "project/role/op/new")

2
templates/repo/new.hamlet
View file

@ -12,8 +12,6 @@ $# 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/>.
Enter your details and click "Submit" to create a new repo.
<form method=POST action=@{ReposR user} enctype=#{enctype}>
^{widget}
<input type=submit>