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