Project page lists project's repos

src/Vervis/Handler/Project.hs

@@ -21,23 +21,35 @@ module Vervis.Handler.Project
     )
 where
 
-import Vervis.Import hiding ((==.))
---import Prelude
+import Prelude
+
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Database.Persist
+import Text.Blaze.Html (Html)
+import Yesod.Auth (requireAuth)
+import Yesod.Core (defaultLayout)
+import Yesod.Core.Handler (redirect, setMessage)
+import Yesod.Form.Functions (runFormPost)
+import Yesod.Form.Types (FormResult (..))
+import Yesod.Persist.Core (runDB, getBy404)
+
+import qualified Database.Esqueleto as E
 
-import Text.Blaze.Html (toHtml)
-import Database.Esqueleto
---import Model
---import Yesod.Core (Handler)
 import Vervis.Form.Project
+import Vervis.Foundation
+import Vervis.Model
+import Vervis.Model.Repo
+import Vervis.Settings
 
 getProjectsR :: Text -> Handler Html
 getProjectsR ident = do
-    projects <- runDB $ select $ from $ \ (sharer, project) -> do
-        where_ $
-            sharer ^. SharerIdent ==. val ident &&.
-            sharer ^. SharerId ==. project ^. ProjectSharer
-        orderBy [asc $ project ^. ProjectIdent]
-        return $ project ^. ProjectIdent
+    projects <- runDB $ E.select $ E.from $ \ (sharer, project) -> do
+        E.where_ $
+            sharer E.^. SharerIdent E.==. E.val ident E.&&.
+            sharer E.^. SharerId E.==. project E.^. ProjectSharer
+        E.orderBy [E.asc $ project E.^. ProjectIdent]
+        return $ project E.^. ProjectIdent
     defaultLayout $(widgetFile "project/list")
 
 postProjectsR :: Text -> Handler Html
@@ -65,9 +77,10 @@ getProjectNewR ident = do
     defaultLayout $(widgetFile "project/new")
 
 getProjectR :: Text -> Text -> Handler Html
-getProjectR user proj = do
-    project <- runDB $ do
-        Entity sid _s <- getBy404 $ UniqueSharerIdent user
-        Entity _pid p <- getBy404 $ UniqueProject proj sid
-        return p
+getProjectR shar proj = do
+    (project, repos) <- runDB $ do
+        Entity sid _s <- getBy404 $ UniqueSharerIdent shar
+        Entity pid p <- getBy404 $ UniqueProject proj sid
+        rs <- selectList [RepoProject ==. Just pid] [Asc RepoIdent]
+        return (p, rs)
     defaultLayout $(widgetFile "project/one")

templates/project/list.hamlet

@@ -15,6 +15,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <p>These are projects shared by #{ident}.
 
 <ul>
-  $forall Value project <- projects
+  $forall E.Value project <- projects
     <li>
       <a href=@{ProjectR ident project}>#{project}

templates/project/one.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/>.
 
-<p>This is the project page for <b>#{proj}</b>, shared by <b>#{user}</b>.
+<p>This is the project page for <b>#{proj}</b>, shared by <b>#{shar}</b>.
 
 <ul>
   <li>
@@ -20,6 +20,28 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   <li>
     Description: #{fromMaybe "(none)" $ projectDesc project}
   <li>
-    TODO list the project's repos here, or link to a separate page that does
-  <li>
-    <a href=@{TicketsR user proj}>Tickets
+    <a href=@{TicketsR shar proj}>Tickets
+
+<h2>Repos
+
+$if null repos
+  <p>This project doesn’t contain repositories.
+$else
+  <table>
+    <tr>
+      <th>Name
+      <th>VCS
+      <th>Description
+    $forall Entity _ repository <- repos
+      <tr>
+        <td>
+          <a href=@{RepoR shar $ repoIdent repository}>#{repoIdent repository}
+        <td>
+          $case repoVcs repository
+            $of VCSDarcs
+              Darcs
+            $of VCSGit
+              Git
+        <td>
+          $maybe desc <- repoDesc repository
+            #{desc}