From ed2df29b669dc8959b5624c8fdaf55397d7b3c6f Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Thu, 5 May 2016 16:30:30 +0000 Subject: [PATCH] Refactor git log view, make room for darcs --- config/routes | 3 +- src/Vervis/Foundation.hs | 7 +- src/Vervis/Handler/Repo.hs | 77 +++++++++++-------- .../{commits.hamlet => changes-git.hamlet} | 0 templates/repo/source-darcs.hamlet | 2 +- templates/repo/source-git.hamlet | 2 +- 6 files changed, 57 insertions(+), 34 deletions(-) rename templates/repo/{commits.hamlet => changes-git.hamlet} (100%) diff --git a/config/routes b/config/routes index ec172c9..79abfb1 100644 --- a/config/routes +++ b/config/routes @@ -44,7 +44,8 @@ /u/#Text/r/!new RepoNewR GET /u/#Text/r/#Text RepoR GET /u/#Text/r/#Text/s/+Texts RepoSourceR GET -/u/#Text/r/#Text/c RepoCommitsR GET +/u/#Text/r/#Text/c RepoHeadChangesR GET +/u/#Text/r/#Text/c/#Text RepoChangesR GET /u/#Text/r/#Text/git/info/refs GitRefDiscoverR GET --/u/#Text/r/#Text/git/git-upload-pack GitUploadRequestR POST diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 204e266..6191fd3 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -62,6 +62,8 @@ mkYesodData "App" $(parseRoutesFile "config/routes") -- | A convenient synonym for creating forms. type Form a = Html -> MForm (HandlerT App IO) (FormResult a, Widget) +type AppDB = YesodDB App + -- Please see the documentation for the Yesod typeclass. There are a number -- of settings which can be configured by overriding methods here. instance Yesod App where @@ -273,7 +275,10 @@ instance YesodBreadcrumbs App where RepoSourceR shar repo $ init refdir ) - RepoCommitsR shar repo -> ("History", Just $ RepoR shar repo) + RepoHeadChangesR shar repo -> ("Changes", Just $ RepoR shar repo) + RepoChangesR shar repo ref -> ( ref + , Just $ RepoHeadChangesR shar repo + ) ProjectsR shar -> ("Projects", Just $ PersonR shar) ProjectNewR shar -> ("New", Just $ ProjectsR shar) diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 1270e6a..6ffe89d 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -19,7 +19,8 @@ module Vervis.Handler.Repo , getRepoNewR , getRepoR , getRepoSourceR - , getRepoCommitsR + , getRepoHeadChangesR + , getRepoChangesR ) where @@ -133,23 +134,24 @@ instance ResultList D.DList where emptyList = D.empty appendItem = flip D.snoc +selectRepo :: Text -> Text -> AppDB Repo +selectRepo shar repo = do + Entity sid _s <- getBy404 $ UniqueSharerIdent shar + Entity _rid r <- getBy404 $ UniqueRepo repo sid + return r + getRepoR :: Text -> Text -> Handler Html -getRepoR user repo = do - repository <- runDB $ do - Entity sid _s <- getBy404 $ UniqueSharerIdent user - Entity _rid r <- getBy404 $ UniqueRepo repo sid - return r +getRepoR shar repo = do + repository <- runDB $ selectRepo shar repo case repoVcs repository of - VCSDarcs -> getDarcsRepoSource repository user repo [] + VCSDarcs -> getDarcsRepoSource repository shar repo [] VCSGit -> getGitRepoSource - repository user repo (repoMainBranch repository) [] + repository shar repo (repoMainBranch repository) [] getDarcsRepoSource :: Repo -> Text -> Text -> [Text] -> Handler Html getDarcsRepoSource repository user repo dir = do path <- askRepoDir user repo - --let toText = decodeUtf8With lenientDecode - -- toTextL = L.decodeUtf8With lenientDecode msv <- liftIO $ D.readSourceView path dir case msv of Nothing -> notFound @@ -157,15 +159,13 @@ getDarcsRepoSource repository user repo dir = do let parent = if null dir then [] else init dir dirs = zip parent (tail $ inits parent) defaultLayout $ do - setTitle $ toHtml $ intercalate " > " $ + setTitle $ toHtml $ intercalate " > " ["Vervis", "People", user, "Repos", repo] $(widgetFile "repo/source-darcs") getGitRepoSource :: Repo -> Text -> Text -> Text -> [Text] -> Handler Html getGitRepoSource repository user repo ref dir = do path <- askRepoDir user repo - --let toText = decodeUtf8With lenientDecode - -- toTextL = L.decodeUtf8With lenientDecode (branches, tags, msv) <- liftIO $ G.readSourceView path ref dir case msv of Nothing -> notFound @@ -178,26 +178,36 @@ getGitRepoSource repository user repo ref dir = do $(widgetFile "repo/source-git") getRepoSourceR :: Text -> Text -> [Text] -> Handler Html -getRepoSourceR user repo refdir = do - repository <- runDB $ do - Entity sid _s <- getBy404 $ UniqueSharerIdent user - Entity _rid r <- getBy404 $ UniqueRepo repo sid - return r +getRepoSourceR shar repo refdir = do + repository <- runDB $ selectRepo shar repo case repoVcs repository of - VCSDarcs -> getDarcsRepoSource repository user repo refdir + VCSDarcs -> getDarcsRepoSource repository shar repo refdir VCSGit -> case refdir of [] -> notFound - (ref:dir) -> getGitRepoSource repository user repo ref dir + (ref:dir) -> getGitRepoSource repository shar repo ref dir -getRepoCommitsR :: Text -> Text -> Handler Html -getRepoCommitsR user repo = do - repository <- runDB $ do - Entity sid _s <- getBy404 $ UniqueSharerIdent user - Entity _rid r <- getBy404 $ UniqueRepo repo sid - return r - path <- askRepoDir user repo +getDarcsRepoHeadChanges :: Text -> Text -> Handler Html +getDarcsRepoHeadChanges shar repo = notFound + +getGitRepoHeadChanges :: Repo -> Text -> Text -> Handler Html +getGitRepoHeadChanges repository shar repo = + getGitRepoChanges shar repo $ repoMainBranch repository + +getRepoHeadChangesR :: Text -> Text -> Handler Html +getRepoHeadChangesR user repo = do + repository <- runDB $ selectRepo user repo + case repoVcs repository of + VCSDarcs -> getDarcsRepoHeadChanges user repo + VCSGit -> getGitRepoHeadChanges repository user repo + +getDarcsRepoChanges :: Text -> Text -> Text -> Handler Html +getDarcsRepoChanges shar repo tag = notFound + +getGitRepoChanges :: Text -> Text -> Text -> Handler Html +getGitRepoChanges shar repo ref = do + path <- askRepoDir shar repo pairs <- liftIO $ withRepo (fromString path) $ \ git -> do - oid <- resolveName git $ unpack $ repoMainBranch repository + oid <- resolveName git $ unpack ref graph <- loadCommitGraphPT git [oid] let mnodes = topsortUnmixOrder graph (NodeStack [noNodes graph]) nodes = case mnodes of @@ -215,5 +225,12 @@ getRepoCommitsR user repo = do rows = map (uncurry mkrow) pairs defaultLayout $ do setTitle $ toHtml $ intercalate " > " - ["Vervis", "People", user, "Repos", repo, "Commits"] - $(widgetFile "repo/commits") + ["Vervis", "People", shar, "Repos", repo, "Commits"] + $(widgetFile "repo/changes-git") + +getRepoChangesR :: Text -> Text -> Text -> Handler Html +getRepoChangesR shar repo ref = do + repository <- runDB $ selectRepo shar repo + case repoVcs repository of + VCSDarcs -> getDarcsRepoChanges shar repo ref + VCSGit -> getGitRepoChanges shar repo ref diff --git a/templates/repo/commits.hamlet b/templates/repo/changes-git.hamlet similarity index 100% rename from templates/repo/commits.hamlet rename to templates/repo/changes-git.hamlet diff --git a/templates/repo/source-darcs.hamlet b/templates/repo/source-darcs.hamlet index 3ce9c98..a16ba36 100644 --- a/templates/repo/source-darcs.hamlet +++ b/templates/repo/source-darcs.hamlet @@ -16,7 +16,7 @@ $maybe desc <- repoDesc repository

#{desc}

- Commits + Changes

Branches diff --git a/templates/repo/source-git.hamlet b/templates/repo/source-git.hamlet index 507ecef..7841bc2 100644 --- a/templates/repo/source-git.hamlet +++ b/templates/repo/source-git.hamlet @@ -16,7 +16,7 @@ $maybe desc <- repoDesc repository

#{desc}

- Commits + Commits

Branches