mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 17:54:53 +09:00
Roles now under by sharers, i.e. now groups too
This commit is contained in:
fr33domlover
parent
05e0d837fa
commit
f2e4bb4291
10 changed files with 127 additions and 119 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
|
|
|||
Loading…
Reference in a new issue