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

This commit is contained in:
fr33domlover 2019-12-27 20:44:14 +00:00
parent 955f7444f6
commit 7654655bcf
5 changed files with 38 additions and 16 deletions

View file

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

View file

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

View file

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

View file

@ -12,6 +12,15 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see $# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>. $# <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 $maybe desc <- repoDesc repository
<p>#{desc} <p>#{desc}

View file

@ -12,6 +12,15 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see $# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>. $# <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 $maybe desc <- repoDesc repository
<p>#{desc} <p>#{desc}