Repos right under users, not under projects

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

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
+/u/#Text/r                              ReposR       GET POST
---       redirect there. consider having a clean way to refer to repos
+/u/#Text/r/!new                         RepoNewR     GET
---       independently of projects...
+/u/#Text/r/#Text                        RepoR        GET
-/u/#Text/p/#Text/r                      ReposR       GET POST
+/u/#Text/r/#Text/s/#Text/+Texts         RepoSourceR  GET
-/u/#Text/p/#Text/r/!new                 RepoNewR     GET
+/u/#Text/r/#Text/c                      RepoCommitsR 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/p/#Text/t           TicketsR   GET
 -- /u/#Text/p/#Text/t/#TicketId TicketR    GET

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
+-- | Make sure the sharer doesn't already have a repo by the same name.
--- 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.
 checkIdentUnique :: SharerId -> Field Handler Text -> Field Handler Text
 checkIdentUnique sid = checkM $ \ ident -> do
-    l <- runDB $ select $ from $ \ (project, repo) -> do
+    mrepo <- runDB $ getBy $ UniqueRepo ident sid
-        where_ $
+    return $ if isNothing mrepo
-            project ^. ProjectSharer ==. val sid &&.
-            repo ^. RepoProject ==. project ^. ProjectId &&.
-            repo ^. RepoIdent ==. val ident
-        limit 1
-        return ()
-    return $ if isNothing $ listToMaybe l
         then Right ident
         else Left ("You already have a repo by that name" :: Text)
 

src/Vervis/Form/Repo.hs

@@ -21,14 +21,15 @@ where
 import Vervis.Import
 import Vervis.Field.Repo
 
-newRepoAForm :: SharerId -> ProjectId -> AForm Handler Repo
+newRepoAForm :: SharerId -> AForm Handler Repo
-newRepoAForm sid pid = 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 :: SharerId -> Form Repo
-newRepoForm sid pid = renderDivs $ newRepoAForm sid pid
+newRepoForm = renderDivs . newRepoAForm

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"

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
+        repos <- runDB $ select $ from $
-            where_ $
+            \ (repo `LeftOuterJoin` project `InnerJoin` sharer) -> do
-                project ^. ProjectSharer E.==. sharer ^. SharerId &&.
+                on $ repo ^. RepoSharer E.==. sharer ^. SharerId
-                repo ^. RepoProject E.==. project ^. ProjectId
+                on $ repo ^. RepoProject E.==. project ?. ProjectId
-            orderBy
+                orderBy
-                [ asc $ sharer ^. SharerIdent
+                    [ asc $ sharer ^. SharerIdent
-                , asc $ project ^. ProjectIdent
+                    , asc $ project ?. ProjectIdent
-                , asc $ repo ^. RepoIdent
+                    , asc $ repo ^. RepoIdent
-                ]
+                    ]
-            return
+                return
-                ( sharer ^. SharerIdent
+                    ( sharer ^. SharerIdent
-                , project ^. ProjectIdent
+                    , project ?. ProjectIdent
-                , repo ^. RepoIdent
+                    , repo ^. RepoIdent
-                )
+                    )
-        root <- appRepoDir . appSettings <$> getYesod
+        root <- askRepoRootDir
-        liftIO $ forM repos $ \ (Value sharer, Value project, Value repo) -> do
+        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")

src/Vervis/Handler/Repo.hs

@@ -73,29 +73,27 @@ import Vervis.Model
 import Vervis.Settings
 import Vervis.Style
 
-getReposR :: Text -> Text -> Handler Html
+getReposR :: Text -> Handler Html
-getReposR user proj = do
+getReposR user = do
-    repos <- runDB $ select $ from $ \ (sharer, project, repo) -> do
+    repos <- runDB $ select $ from $ \ (sharer, repo) -> do
         where_ $
             sharer ^. SharerIdent ==. val user &&.
-            sharer ^. SharerId ==. project ^. ProjectSharer &&.
+            sharer ^. SharerId ==. repo ^. RepoSharer
-            repo ^. RepoProject ==. project ^. ProjectId
         orderBy [asc $ repo ^. RepoIdent]
         return $ repo ^. RepoIdent
     defaultLayout $ do
-        setTitle $ toHtml $ mconcat
+        setTitle $ toHtml $ intercalate " > "
-            ["Vervis > People > ", user, " > Projects > ", proj, " Repos"]
+            ["Vervis", "People", user, "Repos"]
         $(widgetFile "repo/repos")
 
-postReposR :: Text -> Text -> Handler Html
+postReposR :: Text -> Handler Html
-postReposR user proj = do
+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
-    ((result, widget), enctype) <- runFormPost $ newRepoForm sid pid
     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 :: Text -> Handler Html
-getRepoNewR user proj = do
+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
-    ((_result, widget), enctype) <- runFormPost $ newRepoForm sid pid
     defaultLayout $ do
-        setTitle $ toHtml $ mconcat
+        setTitle $ toHtml $ mconcat ["Vervis > People > ", user, " > New Repo"]
-            ["Vervis > People > ", user, " > Projects > ", proj, " > 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 :: Text -> Text -> Handler Html
-getRepoR user proj repo = do
+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 sid
-        Entity _rid r <- getBy404 $ UniqueRepo repo pid
         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 " > " $
+        setTitle $ toHtml $ intercalate " > "
-            ["Vervis", "People", user, "Projects", proj, "Repos", repo]
+            ["Vervis", "People", user, "Repos", repo]
         $(widgetFile "repo/repo")
 
-getRepoSourceR :: Text -> Text -> Text -> Text -> [Text] -> Handler Html
+getRepoSourceR :: Text -> Text -> Text -> [Text] -> Handler Html
-getRepoSourceR user proj repo ref dir = do
+getRepoSourceR user repo ref dir = do
-    path <- askRepoDir user proj repo
+    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 :: Text -> Text -> Handler Html
-getRepoCommitsR user proj repo = do
+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 sid
-        Entity _rid r <- getBy404 $ UniqueRepo repo pid
         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 " > " $
+        setTitle $ toHtml $ intercalate " > "
-            ["Vervis", "People", user, "Projects", proj, "Repos", repo, "Commits"]
+            ["Vervis", "People", user, "Repos", repo, "Commits"]
         $(widgetFile "repo/commits")

src/Vervis/Path.hs

@@ -15,10 +15,8 @@
 
 module Vervis.Path
     ( askRepoRootDir
-    , personDir
+    , sharerDir
-    , askPersonDir
+    , askSharerDir
-    , projectDir
-    , askProjectDir
     , repoDir
     , askRepoDir
     )
@@ -36,26 +34,18 @@ import Vervis.Settings
 askRepoRootDir :: Handler FilePath
 askRepoRootDir = appRepoDir . appSettings <$> getYesod
 
-personDir :: FilePath -> Text -> FilePath
+sharerDir :: FilePath -> Text -> FilePath
-personDir root user = root </> unpack user
+sharerDir root sharer = root </> unpack sharer
 
-askPersonDir :: Text -> Handler FilePath
+askSharerDir :: Text -> Handler FilePath
-askPersonDir user = do
+askSharerDir sharer = do
     root <- askRepoRootDir
-    return $ personDir root user
+    return $ sharerDir root sharer
 
-projectDir :: FilePath -> Text -> Text -> FilePath
+repoDir :: FilePath -> Text -> Text -> FilePath
-projectDir root user proj = root </> unpack user </> unpack proj
+repoDir root sharer repo = sharerDir root sharer </> unpack repo
 
-askProjectDir :: Text -> Text -> Handler FilePath
+askRepoDir :: Text -> Text -> Handler FilePath
-askProjectDir user proj = do
+askRepoDir sharer repo = do
     root <- askRepoRootDir
-    return $ projectDir root user proj
+    return $ repoDir root sharer repo
-
-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

templates/project/project.hamlet

@@ -38,4 +38,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 <p>
   See
-  <a href=@{ReposR user proj}>repos</a>.
+  <a href=@{ReposR user}>repos</a>.

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
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<h1>Vervis > People > #{user} > Projects > #{proj} > Repos > #{repo} > Commits
+<h1>Vervis > People > #{user} > Repos > #{repo} > Commits
 
 <h2>History
 <table>

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
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<h1>Vervis > People > #{user} > Projects > #{proj} > New Repo
+<h1>Vervis > People > #{user} > New Repo
 
 Enter your details and click "Submit" to create a new repo.
 
-<form method=POST action=@{ReposR user proj} enctype=#{enctype}>
+<form method=POST action=@{ReposR user} enctype=#{enctype}>
   ^{widget}
   <input type=submit>

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
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<h1>Vervis > People > #{user} > Projects > #{proj} > Repos > #{repo}
+<h1>Vervis > People > #{user} > Repos > #{repo}
 
 <h2>About
 <p>
-  This is the repo page for <b>#{repo}</b>, which is part of project
+  This is the repo page for <b>#{repo}</b>, shared by user <b>#{user}</b>.
-  <b>#{proj}</b>, shared by user <b>#{user}</b>.
 
 <h2>Details
 <table>
@@ -31,7 +30,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 <h2>Commits
 <p>
-  See <a href=@{RepoCommitsR user proj repo}>commits</a>.
+  See <a href=@{RepoCommitsR user repo}>commits</a>.
 
 <h2>Files
 <table>

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
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<h1>Vervis > People > #{user} > Projects > #{proj} > Repos
+<h1>Vervis > People > #{user} > Repos
 
-<p>These are the repositories of project #{proj} shared by #{user}.
+<p>These are the repositories shared by #{user}.
 
 <ul>
   $forall Value repo <- repos
     <li>
-      <a href=@{RepoR user proj repo}>#{repo}
+      <a href=@{RepoR user repo}>#{repo}
   <li>
-    <a href=@{RepoNewR user proj}>Create new…
+    <a href=@{RepoNewR user}>Create new…

templates/repo/source.hamlet

@@ -12,19 +12,19 @@ $# 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/>.
 
-<h1>Vervis > People > #{user} > Projects > #{proj} > Repos > #{repo}
+<h1>Vervis > People > #{user} > Repos > #{repo}
 
 <h2>Branches
 <ul>
 $forall RefName branch <- branches
   <li>
-    <a href=@{RepoSourceR user proj repo (pack branch) []}>#{branch}
+    <a href=@{RepoSourceR user repo (pack branch) []}>#{branch}
 
 <h2>Tags
 <ul>
 $forall RefName tag <- tags
   <li>
-    <a href=@{RepoSourceR user proj repo (pack tag) []}>#{tag}
+    <a href=@{RepoSourceR user repo (pack tag) []}>#{tag}
 
 <h2>Files for #{ref}
 $case display
@@ -42,5 +42,5 @@ $case display
         <tr>
           <td>#{type'}
           <td>
-            <a href=@{RepoSourceR user proj repo ref (dir ++ [name])}>
+            <a href=@{RepoSourceR user repo ref (dir ++ [name])}>
               #{name}