In repo source page(s), display the project it belongs to

src/Vervis/Handler/Repo.hs

@@ -75,7 +75,7 @@ import Yesod.Core.Content
 import Yesod.Core.Handler (lookupPostParam, redirect, notFound)
 import Yesod.Form.Functions (runFormPost)
 import Yesod.Form.Types (FormResult (..))
-import Yesod.Persist.Core (runDB, getBy404)
+import Yesod.Persist.Core
 
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import qualified Data.CaseInsensitive as CI (foldedCase)
@@ -87,7 +87,7 @@ import qualified Database.Esqueleto as E
 
 import Data.MediaType
 import Network.FedURI
-import Web.ActivityPub hiding (Repo)
+import Web.ActivityPub hiding (Repo, Project)
 import Yesod.ActivityPub
 import Yesod.FedURI
 import Yesod.Hashids
@@ -208,15 +208,19 @@ getRepoNewR user = do
     ((_result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing
     defaultLayout $(widgetFile "repo/new")
 
-selectRepo :: ShrIdent -> RpIdent -> AppDB Repo
+selectRepo :: ShrIdent -> RpIdent -> AppDB (Maybe (Sharer, Project), Repo)
 selectRepo shar repo = do
     Entity sid _s <- getBy404 $ UniqueSharer shar
     Entity _rid r <- getBy404 $ UniqueRepo repo sid
-    return r
+    mj <- for (repoProject r) $ \ jid -> do
+        j <- get404 jid
+        s <- get404 $ projectSharer j
+        return (s, j)
+    return (mj, r)
 
 getRepoR :: ShrIdent -> RpIdent -> Handler TypedContent
 getRepoR shr rp = do
-    repo <- runDB $ selectRepo shr rp
+    (_, repo) <- runDB $ selectRepo shr rp
     encodeRouteLocal <- getEncodeRouteLocal
     encodeRouteHome <- getEncodeRouteHome
     let repoAP = AP.Repo
@@ -313,7 +317,7 @@ getRepoEditR shr rp = do
 getRepoSourceR :: ShrIdent -> RpIdent -> [Text] -> Handler Html
 getRepoSourceR shar repo refdir = do
     repository <- runDB $ selectRepo shar repo
-    case repoVcs repository of
+    case repoVcs $ snd repository of
         VCSDarcs -> getDarcsRepoSource repository shar repo refdir
         VCSGit -> case refdir of
             []           -> notFound
@@ -321,28 +325,28 @@ getRepoSourceR shar repo refdir = do
 
 getRepoHeadChangesR :: ShrIdent -> RpIdent -> Handler TypedContent
 getRepoHeadChangesR user repo = do
-    repository <- runDB $ selectRepo user repo
+    (_, repository) <- runDB $ selectRepo user repo
     case repoVcs repository of
         VCSDarcs -> getDarcsRepoHeadChanges user repo
         VCSGit -> getGitRepoHeadChanges repository user repo
 
 getRepoBranchR :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
 getRepoBranchR shar repo ref = do
-    repository <- runDB $ selectRepo shar repo
+    (_, repository) <- runDB $ selectRepo shar repo
     case repoVcs repository of
         VCSDarcs -> notFound
         VCSGit -> getGitRepoBranch shar repo ref
 
 getRepoChangesR :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
 getRepoChangesR shar repo ref = do
-    repository <- runDB $ selectRepo shar repo
+    (_, repository) <- runDB $ selectRepo shar repo
     case repoVcs repository of
         VCSDarcs -> getDarcsRepoChanges shar repo ref
         VCSGit -> getGitRepoChanges shar repo ref
 
 getRepoPatchR :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
 getRepoPatchR shr rp ref = do
-    repository <- runDB $ selectRepo shr rp
+    (_, repository) <- runDB $ selectRepo shr rp
     case repoVcs repository of
         VCSDarcs -> getDarcsPatch shr rp ref
         VCSGit -> getGitPatch shr rp ref

src/Vervis/Handler/Repo/Darcs.hs

@@ -48,7 +48,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
 
 import Data.MediaType
-import Web.ActivityPub hiding (Repo)
+import Web.ActivityPub hiding (Repo, Project)
 import Yesod.ActivityPub
 import Yesod.FedURI
 import Yesod.RenderSource
@@ -79,8 +79,8 @@ import Vervis.Widget.Sharer
 
 import qualified Vervis.Darcs as D (readSourceView, readChangesView, readPatch)
 
-getDarcsRepoSource :: Repo -> ShrIdent -> RpIdent -> [Text] -> Handler Html
-getDarcsRepoSource repository user repo dir = do
+getDarcsRepoSource :: (Maybe (Sharer, Project), Repo) -> ShrIdent -> RpIdent -> [Text] -> Handler Html
+getDarcsRepoSource (mproject, repository) user repo dir = do
     path <- askRepoDir user repo
     msv <- liftIO $ D.readSourceView path dir
     case msv of

src/Vervis/Handler/Repo/Git.hs

@@ -59,7 +59,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
 
 import Data.MediaType
-import Web.ActivityPub hiding (Commit, Author, Repo)
+import Web.ActivityPub hiding (Commit, Author, Repo, Project)
 import Yesod.ActivityPub
 import Yesod.FedURI
 import Yesod.RenderSource
@@ -94,8 +94,8 @@ import Vervis.Widget.Sharer
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import qualified Vervis.Git as G (readSourceView, readChangesView, listRefs, readPatch)
 
-getGitRepoSource :: Repo -> ShrIdent -> RpIdent -> Text -> [Text] -> Handler Html
-getGitRepoSource repository user repo ref dir = do
+getGitRepoSource :: (Maybe (Sharer, Project), Repo) -> ShrIdent -> RpIdent -> Text -> [Text] -> Handler Html
+getGitRepoSource (mproject, repository) user repo ref dir = do
     path <- askRepoDir user repo
     (branches, tags, msv) <- liftIO $ G.readSourceView path ref dir
     case msv of

templates/repo/source-darcs.hamlet

@@ -12,6 +12,15 @@ $# 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/>.
 
+$maybe (s, j) <- mproject
+  <p>
+    Belongs to project
+    <a href=@{ProjectR (sharerIdent s) (projectIdent j)}>
+      $maybe name <- projectName j
+        #{name}
+      $nothing
+        #{prj2text $ projectIdent j}
+
 $maybe desc <- repoDesc repository
   <p>#{desc}
 

templates/repo/source-git.hamlet

@@ -12,6 +12,15 @@ $# 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/>.
 
+$maybe (s, j) <- mproject
+  <p>
+    Belongs to project
+    <a href=@{ProjectR (sharerIdent s) (projectIdent j)}>
+      $maybe name <- projectName j
+        #{name}
+      $nothing
+        #{prj2text $ projectIdent j}
+
 $maybe desc <- repoDesc repository
   <p>#{desc}