From 5305caf0b02a3a20c77f104a3d6c34d41b884e8b Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sun, 5 Jun 2016 21:11:05 +0000 Subject: [PATCH] Repo settings page, allow repos to move between projects --- config/routes | 3 ++- src/Vervis/Field/Repo.hs | 43 ++++++++++++++++++++++++++++++++++++-- src/Vervis/Form/Project.hs | 6 +++--- src/Vervis/Form/Repo.hs | 24 ++++++++++++++++----- src/Vervis/Foundation.hs | 2 ++ src/Vervis/Handler/Repo.hs | 41 ++++++++++++++++++++++++++++++++++++ templates/repo/edit.hamlet | 18 ++++++++++++++++ 7 files changed, 126 insertions(+), 11 deletions(-) create mode 100644 templates/repo/edit.hamlet diff --git a/config/routes b/config/routes index 2e5a02e..7760bc7 100644 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/src/Vervis/Field/Repo.hs b/src/Vervis/Field/Repo.hs index 88e7a17..2eb562b 100644 --- a/src/Vervis/Field/Repo.hs +++ b/src/Vervis/Field/Repo.hs @@ -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) diff --git a/src/Vervis/Form/Project.hs b/src/Vervis/Form/Project.hs index fb6b108..b164d6c 100644 --- a/src/Vervis/Form/Project.hs +++ b/src/Vervis/Form/Project.hs @@ -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 $ diff --git a/src/Vervis/Form/Repo.hs b/src/Vervis/Form/Repo.hs index e2f8547..8e213f4 100644 --- a/src/Vervis/Form/Repo.hs +++ b/src/Vervis/Form/Repo.hs @@ -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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 20d6830..5592829 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -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 $ diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 106fadc..60e5ff5 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -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 diff --git a/templates/repo/edit.hamlet b/templates/repo/edit.hamlet new file mode 100644 index 0000000..9c766ae --- /dev/null +++ b/templates/repo/edit.hamlet @@ -0,0 +1,18 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ 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 +$# . + +
+ + ^{widget} +