mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 17:44:52 +09:00
Repo settings page, allow repos to move between projects
This commit is contained in:
fr33domlover
parent
72def092b2
commit
5305caf0b0
7 changed files with 126 additions and 11 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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
18
templates/repo/edit.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/>.
|
||||
|
||||
<form method=POST action=@{RepoR shr rp} enctype=#{enctype}>
|
||||
<input type=hidden name=_method value=PUT>
|
||||
^{widget}
|
||||
<input type=submit>
|
||||
Loading…
Reference in a new issue