diff --git a/config/models b/config/models index 0b6c062..cef0f56 100644 --- a/config/models +++ b/config/models @@ -54,13 +54,14 @@ Project Repo ident Text --CI - project ProjectId + sharer SharerId + project ProjectId Maybe desc Text Maybe irc IrcChannelId Maybe ml Text Maybe mainBranch Text default='master' - UniqueRepo ident project + UniqueRepo ident sharer PersonInGroup person PersonId diff --git a/config/routes b/config/routes index 1466955..a6b50d1 100644 --- a/config/routes +++ b/config/routes @@ -44,14 +44,11 @@ /u/#Text/p/!new ProjectNewR GET /u/#Text/p/#Text ProjectR GET --- IDEA: if there's /u/john/p/proj/r/repo, then make /u/john/r/proj-repo --- redirect there. consider having a clean way to refer to repos --- independently of projects... -/u/#Text/p/#Text/r ReposR GET POST -/u/#Text/p/#Text/r/!new RepoNewR GET -/u/#Text/p/#Text/r/#Text RepoR GET -/u/#Text/p/#Text/r/#Text/s/#Text/+Texts RepoSourceR GET -/u/#Text/p/#Text/r/#Text/c RepoCommitsR GET +/u/#Text/r ReposR GET POST +/u/#Text/r/!new RepoNewR GET +/u/#Text/r/#Text RepoR GET +/u/#Text/r/#Text/s/#Text/+Texts RepoSourceR GET +/u/#Text/r/#Text/c RepoCommitsR GET -- /u/#Text/p/#Text/t TicketsR GET -- /u/#Text/p/#Text/t/#TicketId TicketR GET diff --git a/src/Vervis/Field/Repo.hs b/src/Vervis/Field/Repo.hs index b02bab1..46aa34e 100644 --- a/src/Vervis/Field/Repo.hs +++ b/src/Vervis/Field/Repo.hs @@ -18,12 +18,11 @@ module Vervis.Field.Repo ) where -import Vervis.Import hiding ((==.)) +import Vervis.Import import Data.Char (isDigit) import Data.Char.Local (isAsciiLetter) import Data.Text (split) -import Database.Esqueleto hiding (isNothing) checkIdentTemplate :: Field Handler Text -> Field Handler Text checkIdentTemplate = @@ -36,22 +35,11 @@ checkIdentTemplate = \ASCII letters and digits." in checkBool identOk msg --- | Make sure the repo identifier is unique. The DB schema only requires that --- a repo identifier is unique within its project, but I'd like to enforce a --- stronger condition: A repo identifier must be unique within its sharer's --- repos. I'm not yet sure it's a good thing, but it's much easier to maintain --- now and relax later, than relax now and have problems later when there are --- already conflicting names. +-- | Make sure the sharer doesn't already have a repo by the same name. checkIdentUnique :: SharerId -> Field Handler Text -> Field Handler Text checkIdentUnique sid = checkM $ \ ident -> do - l <- runDB $ select $ from $ \ (project, repo) -> do - where_ $ - project ^. ProjectSharer ==. val sid &&. - repo ^. RepoProject ==. project ^. ProjectId &&. - repo ^. RepoIdent ==. val ident - limit 1 - return () - return $ if isNothing $ listToMaybe l + mrepo <- runDB $ getBy $ UniqueRepo ident sid + return $ if isNothing mrepo then Right ident else Left ("You already have a repo by that name" :: Text) diff --git a/src/Vervis/Form/Repo.hs b/src/Vervis/Form/Repo.hs index b19af4c..9d552e6 100644 --- a/src/Vervis/Form/Repo.hs +++ b/src/Vervis/Form/Repo.hs @@ -21,14 +21,15 @@ where import Vervis.Import import Vervis.Field.Repo -newRepoAForm :: SharerId -> ProjectId -> AForm Handler Repo -newRepoAForm sid pid = Repo +newRepoAForm :: SharerId -> AForm Handler Repo +newRepoAForm sid = Repo <$> areq (mkIdentField sid) "Identifier*" Nothing - <*> pure pid + <*> pure sid + <*> pure Nothing <*> aopt textField "Description" Nothing <*> pure Nothing <*> pure Nothing <*> pure "master" -newRepoForm :: SharerId -> ProjectId -> Form Repo -newRepoForm sid pid = renderDivs $ newRepoAForm sid pid +newRepoForm :: SharerId -> Form Repo +newRepoForm = renderDivs . newRepoAForm diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index ed2ae4d..d8808aa 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -107,7 +107,7 @@ instance Yesod App where -- Who can access which pages. isAuthorized (ProjectNewR user) _ = loggedInAs user "You can’t create projects for other users" - isAuthorized (RepoNewR user _proj) _ = + isAuthorized (RepoNewR user) _ = loggedInAs user "You can’t create repos for other users" isAuthorized (KeysR user) _ = loggedInAs user "You can’t watch keys of other users" diff --git a/src/Vervis/Handler/Home.hs b/src/Vervis/Handler/Home.hs index 47bb9a2..d577501 100644 --- a/src/Vervis/Handler/Home.hs +++ b/src/Vervis/Handler/Home.hs @@ -18,39 +18,41 @@ module Vervis.Handler.Home ) where -import Vervis.Import +import Vervis.Import hiding (on) import Database.Esqueleto hiding ((==.)) import Vervis.Git import qualified Database.Esqueleto as E ((==.)) +import Vervis.Path + intro :: Handler Html intro = do rows <- do - repos <- runDB $ select $ from $ \ (sharer, project, repo) -> do - where_ $ - project ^. ProjectSharer E.==. sharer ^. SharerId &&. - repo ^. RepoProject E.==. project ^. ProjectId - orderBy - [ asc $ sharer ^. SharerIdent - , asc $ project ^. ProjectIdent - , asc $ repo ^. RepoIdent - ] - return - ( sharer ^. SharerIdent - , project ^. ProjectIdent - , repo ^. RepoIdent - ) - root <- appRepoDir . appSettings <$> getYesod - liftIO $ forM repos $ \ (Value sharer, Value project, Value repo) -> do + repos <- runDB $ select $ from $ + \ (repo `LeftOuterJoin` project `InnerJoin` sharer) -> do + on $ repo ^. RepoSharer E.==. sharer ^. SharerId + on $ repo ^. RepoProject E.==. project ?. ProjectId + orderBy + [ asc $ sharer ^. SharerIdent + , asc $ project ?. ProjectIdent + , asc $ repo ^. RepoIdent + ] + return + ( sharer ^. SharerIdent + , project ?. ProjectIdent + , repo ^. RepoIdent + ) + root <- askRepoRootDir + liftIO $ forM repos $ \ (Value sharer, Value mproj, Value repo) -> do let path = - root unpack sharer unpack project unpack repo + root unpack sharer unpack repo mdt <- lastChange path ago <- case mdt of Nothing -> return "never" Just dt -> timeAgo dt - return (sharer, project, repo, ago) + return (sharer, fromMaybe "(none)" mproj, repo, ago) defaultLayout $ do setTitle "Welcome to Vervis!" $(widgetFile "homepage") diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 2507de3..e444e87 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -73,29 +73,27 @@ import Vervis.Model import Vervis.Settings import Vervis.Style -getReposR :: Text -> Text -> Handler Html -getReposR user proj = do - repos <- runDB $ select $ from $ \ (sharer, project, repo) -> do +getReposR :: Text -> Handler Html +getReposR user = do + repos <- runDB $ select $ from $ \ (sharer, repo) -> do where_ $ sharer ^. SharerIdent ==. val user &&. - sharer ^. SharerId ==. project ^. ProjectSharer &&. - repo ^. RepoProject ==. project ^. ProjectId + sharer ^. SharerId ==. repo ^. RepoSharer orderBy [asc $ repo ^. RepoIdent] return $ repo ^. RepoIdent defaultLayout $ do - setTitle $ toHtml $ mconcat - ["Vervis > People > ", user, " > Projects > ", proj, " Repos"] + setTitle $ toHtml $ intercalate " > " + ["Vervis", "People", user, "Repos"] $(widgetFile "repo/repos") -postReposR :: Text -> Text -> Handler Html -postReposR user proj = do +postReposR :: Text -> Handler Html +postReposR user = do Entity _pid person <- requireAuth let sid = personIdent person - Entity pid _project <- runDB $ getBy404 $ UniqueProject proj sid - ((result, widget), enctype) <- runFormPost $ newRepoForm sid pid + ((result, widget), enctype) <- runFormPost $ newRepoForm sid case result of FormSuccess repo -> do - parent <- askProjectDir user proj + parent <- askSharerDir user let path = parent unpack (repoIdent repo) liftIO $ createDirectoryIfMissing True parent liftIO $ initRepo $ fromString path @@ -109,29 +107,26 @@ postReposR user proj = do setMessage $ toHtml $ intercalate "; " l defaultLayout $(widgetFile "repo/repo-new") -getRepoNewR :: Text -> Text -> Handler Html -getRepoNewR user proj = do +getRepoNewR :: Text -> Handler Html +getRepoNewR user = do Entity _pid person <- requireAuth let sid = personIdent person - Entity pid _project <- runDB $ getBy404 $ UniqueProject proj sid - ((_result, widget), enctype) <- runFormPost $ newRepoForm sid pid + ((_result, widget), enctype) <- runFormPost $ newRepoForm sid defaultLayout $ do - setTitle $ toHtml $ mconcat - ["Vervis > People > ", user, " > Projects > ", proj, " > New Repo"] + setTitle $ toHtml $ mconcat ["Vervis > People > ", user, " > New Repo"] $(widgetFile "repo/repo-new") instance ResultList D.DList where emptyList = D.empty appendItem = flip D.snoc -getRepoR :: Text -> Text -> Text -> Handler Html -getRepoR user proj repo = do +getRepoR :: Text -> Text -> Handler Html +getRepoR user repo = do repository <- runDB $ do Entity sid _s <- getBy404 $ UniqueSharerIdent user - Entity pid _p <- getBy404 $ UniqueProject proj sid - Entity _rid r <- getBy404 $ UniqueRepo repo pid + Entity _rid r <- getBy404 $ UniqueRepo repo sid return r - path <- askRepoDir user proj repo + path <- askRepoDir user repo view <- liftIO $ withRepo (fromString path) $ \ git -> do oid <- resolveName git $ unpack $ repoMainBranch repository commit <- getCommit git $ unObjId oid @@ -144,13 +139,13 @@ getRepoR user proj repo = do ) rows = map mkrow view defaultLayout $ do - setTitle $ toHtml $ intercalate " > " $ - ["Vervis", "People", user, "Projects", proj, "Repos", repo] + setTitle $ toHtml $ intercalate " > " + ["Vervis", "People", user, "Repos", repo] $(widgetFile "repo/repo") -getRepoSourceR :: Text -> Text -> Text -> Text -> [Text] -> Handler Html -getRepoSourceR user proj repo ref dir = do - path <- askRepoDir user proj repo +getRepoSourceR :: Text -> Text -> Text -> [Text] -> Handler Html +getRepoSourceR user repo ref dir = do + path <- askRepoDir user repo let toText = decodeUtf8With lenientDecode toTextL = L.decodeUtf8With lenientDecode minfo <- liftIO $ withRepo (fromString path) $ \ git -> do @@ -211,17 +206,16 @@ getRepoSourceR user proj repo ref dir = do Right v -> return $ Right $ map mkrow v defaultLayout $ do setTitle $ toHtml $ intercalate " > " $ - ["Vervis", "People", user, "Projects", proj, "Repos", repo] + ["Vervis", "People", user, "Repos", repo] $(widgetFile "repo/source") -getRepoCommitsR :: Text -> Text -> Text -> Handler Html -getRepoCommitsR user proj repo = do +getRepoCommitsR :: Text -> Text -> Handler Html +getRepoCommitsR user repo = do repository <- runDB $ do Entity sid _s <- getBy404 $ UniqueSharerIdent user - Entity pid _p <- getBy404 $ UniqueProject proj sid - Entity _rid r <- getBy404 $ UniqueRepo repo pid + Entity _rid r <- getBy404 $ UniqueRepo repo sid return r - path <- askRepoDir user proj repo + path <- askRepoDir user repo pairs <- liftIO $ withRepo (fromString path) $ \ git -> do oid <- resolveName git $ unpack $ repoMainBranch repository graph <- loadCommitGraphPT git [oid] @@ -240,6 +234,6 @@ getRepoCommitsR user proj repo = do ) rows = map (uncurry mkrow) pairs defaultLayout $ do - setTitle $ toHtml $ intercalate " > " $ - ["Vervis", "People", user, "Projects", proj, "Repos", repo, "Commits"] + setTitle $ toHtml $ intercalate " > " + ["Vervis", "People", user, "Repos", repo, "Commits"] $(widgetFile "repo/commits") diff --git a/src/Vervis/Path.hs b/src/Vervis/Path.hs index 7f84fe6..dd564cb 100644 --- a/src/Vervis/Path.hs +++ b/src/Vervis/Path.hs @@ -15,10 +15,8 @@ module Vervis.Path ( askRepoRootDir - , personDir - , askPersonDir - , projectDir - , askProjectDir + , sharerDir + , askSharerDir , repoDir , askRepoDir ) @@ -36,26 +34,18 @@ import Vervis.Settings askRepoRootDir :: Handler FilePath askRepoRootDir = appRepoDir . appSettings <$> getYesod -personDir :: FilePath -> Text -> FilePath -personDir root user = root unpack user +sharerDir :: FilePath -> Text -> FilePath +sharerDir root sharer = root unpack sharer -askPersonDir :: Text -> Handler FilePath -askPersonDir user = do +askSharerDir :: Text -> Handler FilePath +askSharerDir sharer = do root <- askRepoRootDir - return $ personDir root user + return $ sharerDir root sharer -projectDir :: FilePath -> Text -> Text -> FilePath -projectDir root user proj = root unpack user unpack proj +repoDir :: FilePath -> Text -> Text -> FilePath +repoDir root sharer repo = sharerDir root sharer unpack repo -askProjectDir :: Text -> Text -> Handler FilePath -askProjectDir user proj = do +askRepoDir :: Text -> Text -> Handler FilePath +askRepoDir sharer repo = do root <- askRepoRootDir - return $ projectDir root user proj - -repoDir :: FilePath -> Text -> Text -> Text -> FilePath -repoDir root user proj repo = projectDir root user proj unpack repo - -askRepoDir :: Text -> Text -> Text -> Handler FilePath -askRepoDir user proj repo = do - root <- askRepoRootDir - return $ repoDir root user proj repo + return $ repoDir root sharer repo diff --git a/templates/project/project.hamlet b/templates/project/project.hamlet index efb48c4..70902d7 100644 --- a/templates/project/project.hamlet +++ b/templates/project/project.hamlet @@ -38,4 +38,4 @@ $# .

See - repos. + repos. diff --git a/templates/repo/commits.hamlet b/templates/repo/commits.hamlet index f34537a..32afe2e 100644 --- a/templates/repo/commits.hamlet +++ b/templates/repo/commits.hamlet @@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -

Vervis > People > #{user} > Projects > #{proj} > Repos > #{repo} > Commits +

Vervis > People > #{user} > Repos > #{repo} > Commits

History diff --git a/templates/repo/repo-new.hamlet b/templates/repo/repo-new.hamlet index e3a67c3..c25071b 100644 --- a/templates/repo/repo-new.hamlet +++ b/templates/repo/repo-new.hamlet @@ -12,10 +12,10 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -

Vervis > People > #{user} > Projects > #{proj} > New Repo +

Vervis > People > #{user} > New Repo Enter your details and click "Submit" to create a new repo. -
+ ^{widget} diff --git a/templates/repo/repo.hamlet b/templates/repo/repo.hamlet index 5bbbddc..b91bca7 100644 --- a/templates/repo/repo.hamlet +++ b/templates/repo/repo.hamlet @@ -12,12 +12,11 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -

Vervis > People > #{user} > Projects > #{proj} > Repos > #{repo} +

Vervis > People > #{user} > Repos > #{repo}

About

- This is the repo page for #{repo}, which is part of project - #{proj}, shared by user #{user}. + This is the repo page for #{repo}, shared by user #{user}.

Details

@@ -31,7 +30,7 @@ $# .

Commits

- See commits. + See commits.

Files

diff --git a/templates/repo/repos.hamlet b/templates/repo/repos.hamlet index b32d809..b7e13c6 100644 --- a/templates/repo/repos.hamlet +++ b/templates/repo/repos.hamlet @@ -12,13 +12,13 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -

Vervis > People > #{user} > Projects > #{proj} > Repos +

Vervis > People > #{user} > Repos -

These are the repositories of project #{proj} shared by #{user}. +

These are the repositories shared by #{user}.

#{type'} - + #{name}