diff --git a/src/Vervis/Darcs.hs b/src/Vervis/Darcs.hs index 43262ca..65409b4 100644 --- a/src/Vervis/Darcs.hs +++ b/src/Vervis/Darcs.hs @@ -15,9 +15,9 @@ -} module Vervis.Darcs - ( --readSourceView + ( readSourceView --, readWikiView - readChangesView + , readChangesView --, lastChange , readPatch , writePostApplyHooks @@ -97,7 +97,6 @@ import Vervis.Readme import Vervis.Settings import Vervis.SourceTree -{- dirToAnchoredPath :: [EntryName] -> AnchoredPath dirToAnchoredPath = AnchoredPath . map (decodeWhiteName . encodeUtf8) @@ -166,7 +165,6 @@ readSourceView path dir = do let mitem = find expandedTree anch for mitem $ itemToSourceView (last dir) return $ renderSources dir <$> msv --} {- readWikiView diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index 0893963..7adec50 100644 --- a/src/Vervis/Git.hs +++ b/src/Vervis/Git.hs @@ -15,8 +15,8 @@ -} module Vervis.Git - ( --readSourceView - readChangesView + ( readSourceView + , readChangesView , listRefs , readPatch --, lastCommitTime @@ -97,7 +97,6 @@ import Vervis.Readme import Vervis.Settings import Vervis.SourceTree -{- matchReadme :: (ModePerm, ObjId, Text, EntObjType) -> Bool matchReadme (_, _, name, EntObjBlob) = isReadme name matchReadme _ = False @@ -171,7 +170,6 @@ readSourceView path ref dir = do G.withRepo (fromString path) $ \ git -> loadSourceView git ref dir let toTexts = S.mapMonotonic $ T.pack . refNameRaw return (toTexts bs, toTexts ts, renderSources dir <$> msv) --} readChangesView :: FilePath diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 924495e..086bf21 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -59,9 +59,9 @@ module Vervis.Handler.Repo , deleteRepoDevR , postRepoDevR , getRepoTeamR + -} , getHighlightStyleR - -} ) where @@ -359,20 +359,22 @@ postGitUploadRequestR repoHash = do getRepoSourceR :: KeyHashid Repo -> [Text] -> Handler Html getRepoSourceR repoHash path = do repoID <- decodeKeyHashid404 repoHash - repo <- runDB $ get404 repoID + (repo, actor) <- runDB $ do + r <- get404 repoID + (r,) <$> getJust (repoActor r) case repoVcs repo of - VCSDarcs -> error "Temporarily disabled" - --getDarcsRepoSource repo repoHash path + VCSDarcs -> getDarcsRepoSource repo actor repoHash path VCSGit -> notFound getRepoBranchSourceR :: KeyHashid Repo -> Text -> [Text] -> Handler Html getRepoBranchSourceR repoHash branch path = do repoID <- decodeKeyHashid404 repoHash - repo <- runDB $ get404 repoID + (repo, actor) <- runDB $ do + r <- get404 repoID + (r,) <$> getJust (repoActor r) case repoVcs repo of VCSDarcs -> notFound - VCSGit -> error "Temporarily disabled" - --getGitRepoSource repo repoHash branch dir + VCSGit -> getGitRepoSource repo actor repoHash branch path getRepoCommitsR :: KeyHashid Repo -> Handler TypedContent getRepoCommitsR repoHash = do @@ -855,6 +857,7 @@ getRepoFollowersR shr rp = getFollowersCollection here getFsid sid <- getKeyBy404 $ UniqueSharer shr r <- getValBy404 $ UniqueRepo rp sid return $ repoFollowers r +-} getHighlightStyleR :: Text -> Handler TypedContent getHighlightStyleR styleName = @@ -862,4 +865,3 @@ getHighlightStyleR styleName = Nothing -> notFound Just style -> return $ TypedContent typeCss $ toContent $ styleToCss style --} diff --git a/src/Vervis/Web/Darcs.hs b/src/Vervis/Web/Darcs.hs index d4315a2..6f0dea0 100644 --- a/src/Vervis/Web/Darcs.hs +++ b/src/Vervis/Web/Darcs.hs @@ -15,8 +15,8 @@ -} module Vervis.Web.Darcs - ( --getDarcsRepoSource - getDarcsRepoChanges + ( getDarcsRepoSource + , getDarcsRepoChanges , getDarcsPatch ) where @@ -29,7 +29,7 @@ import Data.Text.Encoding import Data.Text.Encoding.Error (lenientDecode) import Data.Traversable (for) import Database.Esqueleto -import Network.HTTP.Types (StdMethod (DELETE)) +import Network.HTTP.Types import System.FilePath ((), joinPath) import System.Directory (doesFileExist) import Text.Blaze.Html (Html) @@ -48,12 +48,13 @@ import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With) import Data.MediaType import Development.PatchMediaType -import Web.ActivityPub hiding (Repo, Project) import Yesod.ActivityPub import Yesod.FedURI import Yesod.Hashids import Yesod.RenderSource +import qualified Web.ActivityPub as AP + import Data.ByteString.Char8.Local (takeLine) import Data.Paginate.Local import Data.Patch.Local @@ -72,14 +73,16 @@ import Vervis.SourceTree import Vervis.Style import Vervis.Time import Vervis.Web.Repo +import Vervis.Widget +import Vervis.Widget.Person import Vervis.Widget.Repo import qualified Vervis.Darcs as D -{- -getDarcsRepoSource :: (Maybe (Sharer, Project, Workflow, Sharer), Repo) -> ShrIdent -> RpIdent -> [Text] -> Handler Html -getDarcsRepoSource (mproject, repository) user repo dir = do - path <- askRepoDir user repo +getDarcsRepoSource + :: Repo -> Actor -> KeyHashid Repo -> [Text] -> Handler Html +getDarcsRepoSource repository actor repo dir = do + path <- askRepoDir repo msv <- liftIO $ D.readSourceView path dir case msv of Nothing -> notFound @@ -96,11 +99,7 @@ getDarcsRepoSource (mproject, repository) user repo dir = do $(widgetFile "repo/source-darcs") where followButton = - followW - (RepoFollowR user repo) - (RepoUnfollowR user repo) - (return $ repoFollowers repository) --} + followW (RepoFollowR repo) (RepoUnfollowR repo) (actorFollowers actor) getDarcsRepoChanges :: KeyHashid Repo -> Handler TypedContent getDarcsRepoChanges repo = do @@ -119,36 +118,36 @@ getDarcsRepoChanges repo = do case mpage of Nothing -> do (total, pages, _, _) <- getPageAndNavTop getChanges - let collection = Collection - { collectionId = encodeRouteLocal here - , collectionType = CollectionTypeOrdered - , collectionTotalItems = Just total - , collectionCurrent = Nothing - , collectionFirst = Just $ pageUrl 1 - , collectionLast = Just $ pageUrl pages - , collectionItems = [] :: [Text] + let collection = AP.Collection + { AP.collectionId = encodeRouteLocal here + , AP.collectionType = AP.CollectionTypeOrdered + , AP.collectionTotalItems = Just total + , AP.collectionCurrent = Nothing + , AP.collectionFirst = Just $ pageUrl 1 + , AP.collectionLast = Just $ pageUrl pages + , AP.collectionItems = [] :: [Text] } provideHtmlAndAP collection $ redirectFirstPage here Just (_total, pages, items, navModel) -> let current = nmCurrent navModel - page = CollectionPage - { collectionPageId = pageUrl current - , collectionPageType = CollectionPageTypeOrdered - , collectionPageTotalItems = Nothing - , collectionPageCurrent = Just $ pageUrl current - , collectionPageFirst = Just $ pageUrl 1 - , collectionPageLast = Just $ pageUrl pages - , collectionPagePartOf = encodeRouteLocal here - , collectionPagePrev = + page = AP.CollectionPage + { AP.collectionPageId = pageUrl current + , AP.collectionPageType = AP.CollectionPageTypeOrdered + , AP.collectionPageTotalItems = Nothing + , AP.collectionPageCurrent = Just $ pageUrl current + , AP.collectionPageFirst = Just $ pageUrl 1 + , AP.collectionPageLast = Just $ pageUrl pages + , AP.collectionPagePartOf = encodeRouteLocal here + , AP.collectionPagePrev = if current > 1 then Just $ pageUrl $ current - 1 else Nothing - , collectionPageNext = + , AP.collectionPageNext = if current < pages then Just $ pageUrl $ current + 1 else Nothing - , collectionPageStartIndex = Nothing - , collectionPageItems = + , AP.collectionPageStartIndex = Nothing + , AP.collectionPageItems = map (encodeRouteHome . RepoCommitR repo . leHash) items } diff --git a/src/Vervis/Web/Git.hs b/src/Vervis/Web/Git.hs index 3e0eba1..1c1cbd1 100644 --- a/src/Vervis/Web/Git.hs +++ b/src/Vervis/Web/Git.hs @@ -15,9 +15,9 @@ -} module Vervis.Web.Git - ( --getGitRepoSource + ( getGitRepoSource --, getGitRepoBranch - getGitRepoChanges + , getGitRepoChanges , getGitPatch ) where @@ -42,7 +42,7 @@ import Data.Text.Encoding.Error (lenientDecode) import Data.Traversable (for) import Database.Esqueleto import Data.Hourglass (timeConvert) -import Network.HTTP.Types (StdMethod (DELETE)) +import Network.HTTP.Types import System.Directory (createDirectoryIfMissing) import System.Hourglass (dateCurrent) import Text.Blaze.Html (Html) @@ -59,7 +59,6 @@ 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, Project) import Yesod.ActivityPub import Yesod.FedURI import Yesod.Hashids @@ -88,15 +87,17 @@ import Vervis.SourceTree import Vervis.Style import Vervis.Time (showDate) import Vervis.Web.Repo +import Vervis.Widget +import Vervis.Widget.Person import Vervis.Widget.Repo import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Vervis.Git as G -{- -getGitRepoSource :: (Maybe (Sharer, Project, Workflow, Sharer), Repo) -> ShrIdent -> RpIdent -> Text -> [Text] -> Handler Html -getGitRepoSource (mproject, repository) user repo ref dir = do - path <- askRepoDir user repo +getGitRepoSource + :: Repo -> Actor -> KeyHashid Repo -> Text -> [Text] -> Handler Html +getGitRepoSource repository actor repo ref dir = do + path <- askRepoDir repo (branches, tags, msv) <- liftIO $ G.readSourceView path ref dir case msv of Nothing -> notFound @@ -113,11 +114,7 @@ getGitRepoSource (mproject, repository) user repo ref dir = do $(widgetFile "repo/source-git") where followButton = - followW - (RepoFollowR user repo) - (RepoUnfollowR user repo) - (return $ repoFollowers repository) --} + followW (RepoFollowR repo) (RepoUnfollowR repo) (actorFollowers actor) {- getGitRepoBranch :: ShrIdent -> RpIdent -> Text -> Handler TypedContent @@ -153,36 +150,36 @@ getGitRepoChanges repo ref = do case mpage of Nothing -> do (total, pages, _, _) <- getPageAndNavTop getChanges - let collection = Collection - { collectionId = encodeRouteLocal here - , collectionType = CollectionTypeOrdered - , collectionTotalItems = Just total - , collectionCurrent = Nothing - , collectionFirst = Just $ pageUrl 1 - , collectionLast = Just $ pageUrl pages - , collectionItems = [] :: [Text] + let collection = AP.Collection + { AP.collectionId = encodeRouteLocal here + , AP.collectionType = AP.CollectionTypeOrdered + , AP.collectionTotalItems = Just total + , AP.collectionCurrent = Nothing + , AP.collectionFirst = Just $ pageUrl 1 + , AP.collectionLast = Just $ pageUrl pages + , AP.collectionItems = [] :: [Text] } provideHtmlAndAP collection $ redirectFirstPage here Just (_total, pages, items, navModel) -> let current = nmCurrent navModel - page = CollectionPage - { collectionPageId = pageUrl current - , collectionPageType = CollectionPageTypeOrdered - , collectionPageTotalItems = Nothing - , collectionPageCurrent = Just $ pageUrl current - , collectionPageFirst = Just $ pageUrl 1 - , collectionPageLast = Just $ pageUrl pages - , collectionPagePartOf = encodeRouteLocal here - , collectionPagePrev = + page = AP.CollectionPage + { AP.collectionPageId = pageUrl current + , AP.collectionPageType = AP.CollectionPageTypeOrdered + , AP.collectionPageTotalItems = Nothing + , AP.collectionPageCurrent = Just $ pageUrl current + , AP.collectionPageFirst = Just $ pageUrl 1 + , AP.collectionPageLast = Just $ pageUrl pages + , AP.collectionPagePartOf = encodeRouteLocal here + , AP.collectionPagePrev = if current > 1 then Just $ pageUrl $ current - 1 else Nothing - , collectionPageNext = + , AP.collectionPageNext = if current < pages then Just $ pageUrl $ current + 1 else Nothing - , collectionPageStartIndex = Nothing - , collectionPageItems = + , AP.collectionPageStartIndex = Nothing + , AP.collectionPageItems = map (encodeRouteHome . RepoCommitR repo . leHash) items } diff --git a/templates/repo/source-darcs.hamlet b/templates/repo/source-darcs.hamlet index 2d3dbc2..3c561f0 100644 --- a/templates/repo/source-darcs.hamlet +++ b/templates/repo/source-darcs.hamlet @@ -13,54 +13,51 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -$maybe (s, j, w, sw) <- mproject -

- Belongs to project - - $maybe name <- projectName j - #{name} - $nothing - #{prj2text $ projectIdent j} +$# $maybe (s, j, w, sw) <- mproject +$#

+$# Belongs to project +$# +$# $maybe name <- projectName j +$# #{name} +$# $nothing +$# #{prj2text $ projectIdent j} +$# +$# ^{personNavW $ sharerIdent s} +$# +$# ^{projectNavW j w sw (sharerIdent s) (projectIdent j)} - ^{personNavW $ sharerIdent s} +

#{actorDesc actor} - ^{projectNavW j w sw (sharerIdent s) (projectIdent j)} - -$maybe desc <- repoDesc repository -

#{desc} - -^{personNavW user} +$# ^{personNavW user}

[[ 🗃 - - #{rp2text repo} + + ^#{keyHashidText repo} #{actorName actor} ]] :: - + [📥 Inbox] - + [📤 Outbox] - + [🐤 Followers] - [🤝 Collaborators] - + [🛠 Changes] - [🧩 Patches] ^{followButton}

Clone -darcs clone @{RepoR user repo} +darcs clone @{RepoR repo}

Tags @@ -68,7 +65,7 @@ $maybe desc <- repoDesc repository
$forall (piece, piecePath) <- dirs - #{piece} + #{piece} / # $case sv @@ -90,15 +87,15 @@ $case sv $of TypeTree 🗀 - + #{name} $maybe (readmeName, readmeWidget) <- mreadme

#{readmeName} ^{readmeWidget}
- ^{buttonW DELETE "Delete this repo" (RepoR user repo)} + ^{buttonW POST "Delete this repo" (RepoDeleteR repo)}
- + [See repo JSON] diff --git a/templates/repo/source-git.hamlet b/templates/repo/source-git.hamlet index 5e60568..09676c9 100644 --- a/templates/repo/source-git.hamlet +++ b/templates/repo/source-git.hamlet @@ -13,74 +13,71 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -$maybe (s, j, w, sw) <- mproject -

- Belongs to project - - $maybe name <- projectName j - #{name} - $nothing - #{prj2text $ projectIdent j} +$# $maybe (s, j, w, sw) <- mproject +$#

+$# Belongs to project +$# +$# $maybe name <- projectName j +$# #{name} +$# $nothing +$# #{prj2text $ projectIdent j} +$# +$# ^{personNavW $ sharerIdent s} +$# +$# ^{projectNavW j w sw (sharerIdent s) (projectIdent j)} - ^{personNavW $ sharerIdent s} +

#{actorDesc actor} - ^{projectNavW j w sw (sharerIdent s) (projectIdent j)} - -$maybe desc <- repoDesc repository -

#{desc} - -^{personNavW user} +$# ^{personNavW user}

[[ 🗃 - - #{rp2text repo} + + ^#{keyHashidText repo} #{actorName actor} ]] :: - + [📥 Inbox] - + [📤 Outbox] - + [🐤 Followers] - [🤝 Collaborators] - + [🛠 Commits] - [🧩 Merge Requests] ^{followButton}

Clone -git clone @{RepoR user repo} +git clone @{RepoR repo}

Branches