forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Repo settings page, allow repos to move between projects

Browse source
This commit is contained in:
fr33domlover 2016-06-05 21:11:05 +00:00
parent 72def092b2
commit 5305caf0b0
7 changed files with 126 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
config/routes
View file

@ -68,7 +68,8 @@
/s/#ShrIdent/r ReposR GET POST
/s/#ShrIdent/r/!new RepoNewR GET
/s/#ShrIdent/r/#RpIdent RepoR GET DELETE POST
/s/#ShrIdent/r/#RpIdent RepoR GET PUT DELETE POST
/s/#ShrIdent/r/#RpIdent/edit RepoEditR GET
/s/#ShrIdent/r/#RpIdent/s/+Texts RepoSourceR GET
/s/#ShrIdent/r/#RpIdent/c RepoHeadChangesR GET
/s/#ShrIdent/r/#RpIdent/c/#Text RepoChangesR GET

43
src/Vervis/Field/Repo.hs
View file

@ -15,17 +15,21 @@
module Vervis.Field.Repo
( mkIdentField
, selectProjectForNew
, selectProjectForExisting
)
where
import Vervis.Import hiding ((==.))
import Vervis.Import hiding ((==.), on, isNothing)
import Data.Char (isDigit)
import Data.Char.Local (isAsciiLetter)
import Data.Text (split)
import Database.Esqueleto
import Vervis.Model.Ident (text2rp)
import qualified Database.Persist as P ((==.))
import Vervis.Model.Ident (text2rp, prj2text)
checkIdentTemplate :: Field Handler Text -> Field Handler Text
checkIdentTemplate =
@ -54,3 +58,38 @@ checkIdentUnique sid = checkM $ \ ident -> do
mkIdentField :: SharerId -> Field Handler Text
mkIdentField sid = checkIdentUnique sid . checkIdentTemplate $ textField
-- | Select a project for a new repository to belong to. It can be any project
-- of the same sharer who's sharing the repo.
selectProjectForNew :: SharerId -> Field Handler ProjectId
selectProjectForNew sid =
selectField $
optionsPersistKey [ProjectSharer P.==. sid] [] $
prj2text . projectIdent
-- | Select a project for a repository to belong to. It can be any project of
-- the same sharer who's sharing the repo.
--
-- However, there's an additional requirement that all repo collaborators are
-- also project collaborators. I'm not sure I want this requirement, but it's
-- easier to require it now and remove later, than require it later when the DB
-- is already full of live repos and projects.
--
-- Also, a repo that is the wiki of the project can't be moved, but this is NOT
-- CHECKED HERE. That's something to check before running the form, i.e. in the
-- handler itself.
selectProjectForExisting :: SharerId -> RepoId -> Field Handler ProjectId
selectProjectForExisting sid rid = checkMembers $ selectProjectForNew sid
where
checkMembers = checkM $ \ jid -> do
l <- runDB $ select $ from $ \ (rc `LeftOuterJoin` pc) -> do
on $
rc ^. RepoCollabRepo ==. val rid &&.
pc ?. ProjectCollabProject ==. just (val jid) &&.
pc ?. ProjectCollabPerson ==. just (rc ^. RepoCollabPerson)
where_ $ isNothing $ pc ?. ProjectCollabId
limit 1
return ()
return $ if null l
then Right jid
else Left ("Some repo members aren't project members" :: Text)

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

@ -77,10 +77,10 @@ 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)
<*> aopt textField "Name" (Just $ projectName project)
<*> aopt textField "Description" (Just $ projectDesc project)
<*> pure (projectNextTicket project)
<*> aopt selectWiki "Wiki*" (Just $ projectWiki project)
<*> aopt selectWiki "Wiki" (Just $ projectWiki project)
where
selectWiki =
selectField $

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

@ -18,6 +18,7 @@ module Vervis.Form.Repo
, newRepoForm
, NewRepoCollab (..)
, newRepoCollabForm
, editRepoForm
)
where
@ -46,7 +47,7 @@ newRepoAForm
newRepoAForm pid sid mpid = NewRepo
<$> (text2rp <$> areq (mkIdentField sid) "Identifier*" Nothing)
<*> areq (selectFieldList vcsList) "Version control system*" Nothing
<*> aopt selectProject "Project" (Just mpid)
<*> aopt (selectProjectForNew sid) "Project" (Just mpid)
<*> aopt textField "Description" Nothing
<*> areq selectRole "Your role*" Nothing
where
@ -55,10 +56,6 @@ newRepoAForm pid sid mpid = NewRepo
[ ("Darcs", VCSDarcs)
, ("Git" , VCSGit)
]
selectProject =
selectField $
optionsPersistKey [ProjectSharer ==. sid] [Asc ProjectIdent] $
prj2text . projectIdent
selectRole =
selectField $
optionsPersistKey [RepoRolePerson ==. pid] [] $
@ -113,3 +110,20 @@ newRepoCollabAForm pid mjid rid = NewRepoCollab
newRepoCollabForm
:: PersonId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab
newRepoCollabForm pid mjid rid = renderDivs $ newRepoCollabAForm pid mjid rid
editRepoAForm :: Entity Repo -> AForm Handler Repo
editRepoAForm (Entity rid repo) = Repo
<$> pure (repoIdent repo)
<*> pure (repoSharer repo)
<*> pure (repoVcs repo)
<*> aopt selectProject' "Project" (Just $ repoProject repo)
<*> aopt textField "Description" (Just $ repoDesc repo)
<*> let b = repoMainBranch repo
in case repoVcs repo of
VCSDarcs -> pure b
VCSGit -> areq textField "Main branch*" (Just b)
where
selectProject' = selectProjectForExisting (repoSharer repo) rid
editRepoForm :: Entity Repo -> Form Repo
editRepoForm r = renderDivs $ editRepoAForm r

2
src/Vervis/Foundation.hs
View file

@ -144,6 +144,7 @@ instance Yesod App where
(ReposR shar , True) -> person shar
(RepoNewR user , _ ) -> person user
(RepoR shar _ , True) -> person shar
(RepoEditR shr _rp , _ ) -> person shr
(RepoDevsR shr _rp , _ ) -> person shr
(RepoDevNewR shr _rp , _ ) -> person shr
(RepoDevR shr _rp _dev , _ ) -> person shr
@ -329,6 +330,7 @@ instance YesodBreadcrumbs App where
ReposR shar -> ("Repos", Just $ PersonR shar)
RepoNewR shar -> ("New", Just $ ReposR shar)
RepoR shar repo -> (rp2text repo, Just $ ReposR shar)
RepoEditR shr rp -> ("Edit", Just $ RepoR shr rp)
RepoSourceR shar repo [] -> ("Files", Just $ RepoR shar repo)
RepoSourceR shar repo refdir -> ( last refdir
, Just $

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

@ -18,8 +18,10 @@ module Vervis.Handler.Repo
, postReposR
, getRepoNewR
, getRepoR
, putRepoR
, deleteRepoR
, postRepoR
, getRepoEditR
, getRepoSourceR
, getRepoHeadChangesR
, getRepoChangesR
@ -51,6 +53,7 @@ import Data.List (inits)
import Data.Text (Text, unpack)
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Traversable (for)
import Database.Esqueleto hiding (delete, (%))
import Database.Persist (delete)
import Data.Hourglass (timeConvert)
@ -170,6 +173,35 @@ getRepoR shar repo = do
getGitRepoSource
repository shar repo (repoMainBranch repository) []
putRepoR :: ShrIdent -> RpIdent -> Handler Html
putRepoR shr rp = do
mer <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
er@(Entity rid r) <- getBy404 $ UniqueRepo rp sid
mwiki <- for (repoProject r) $ \ jid -> do
project <- getJust jid
return $ (== rid) <$> projectWiki project
return $ case mwiki of
Just (Just True) -> Nothing
_ -> Just er
case mer of
Nothing -> do
setMessage "Repo used as a wiki, can't move between projects."
redirect $ RepoR shr rp
Just er@(Entity rid _) -> do
((result, widget), enctype) <- runFormPost $ editRepoForm er
case result of
FormSuccess repository' -> do
runDB $ replace rid repository'
setMessage "Repository updated."
redirect $ RepoR shr rp
FormMissing -> do
setMessage "Field(s) missing."
defaultLayout $(widgetFile "repo/edit")
FormFailure _l -> do
setMessage "Repository update failed, see errors below."
defaultLayout $(widgetFile "repo/edit")
deleteRepoR :: ShrIdent -> RpIdent -> Handler Html
deleteRepoR shar repo = do
runDB $ do
@ -193,9 +225,18 @@ postRepoR :: ShrIdent -> RpIdent -> Handler Html
postRepoR shar repo = do
mmethod <- lookupPostParam "_method"
case mmethod of
Just "PUT" -> putRepoR shar repo
Just "DELETE" -> deleteRepoR shar repo
_ -> notFound
getRepoEditR :: ShrIdent -> RpIdent -> Handler Html
getRepoEditR shr rp = do
er <- runDB $ do
Entity s _ <- getBy404 $ UniqueSharer shr
getBy404 $ UniqueRepo rp s
((_result, widget), enctype) <- runFormPost $ editRepoForm er
defaultLayout $(widgetFile "repo/edit")
getRepoSourceR :: ShrIdent -> RpIdent -> [Text] -> Handler Html
getRepoSourceR shar repo refdir = do
repository <- runDB $ selectRepo shar repo

18
templates/repo/edit.hamlet Normal file
View 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/>.
<form method=POST action=@{RepoR shr rp} enctype=#{enctype}>
<input type=hidden name=_method value=PUT>
^{widget}
<input type=submit>