Add repo commits route
This commit is contained in:
parent
4c32d038b3
commit
fa4e4294b1
2 changed files with 49 additions and 17 deletions
|
@ -50,6 +50,7 @@
|
||||||
/u/#Text/p/#Text/r ReposR GET POST
|
/u/#Text/p/#Text/r ReposR GET POST
|
||||||
/u/#Text/p/#Text/r/!new RepoNewR GET
|
/u/#Text/p/#Text/r/!new RepoNewR GET
|
||||||
/u/#Text/p/#Text/r/#Text RepoR GET
|
/u/#Text/p/#Text/r/#Text RepoR GET
|
||||||
|
/u/#Text/p/#Text/r/#Text/c RepoCommitsR GET
|
||||||
|
|
||||||
-- /u/#Text/p/#Text/t TicketsR GET
|
-- /u/#Text/p/#Text/t TicketsR GET
|
||||||
-- /u/#Text/p/#Text/t/#TicketId TicketR GET
|
-- /u/#Text/p/#Text/t/#TicketId TicketR GET
|
||||||
|
|
|
@ -18,6 +18,7 @@ module Vervis.Handler.Repo
|
||||||
, postReposR
|
, postReposR
|
||||||
, getRepoNewR
|
, getRepoNewR
|
||||||
, getRepoR
|
, getRepoR
|
||||||
|
, getRepoCommitsR
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -140,3 +141,33 @@ getRepoR user proj repo = do
|
||||||
setTitle $ toHtml $ intercalate " > " $
|
setTitle $ toHtml $ intercalate " > " $
|
||||||
["Vervis", "People", user, "Projects", proj, "Repos", repo]
|
["Vervis", "People", user, "Projects", proj, "Repos", repo]
|
||||||
$(widgetFile "repo/repo")
|
$(widgetFile "repo/repo")
|
||||||
|
|
||||||
|
getRepoCommitsR :: Text -> Text -> Text -> Handler Html
|
||||||
|
getRepoCommitsR user proj repo = do
|
||||||
|
repository <- runDB $ do
|
||||||
|
Entity sid _s <- getBy404 $ UniqueSharerIdent user
|
||||||
|
Entity pid _p <- getBy404 $ UniqueProject proj sid
|
||||||
|
Entity _rid r <- getBy404 $ UniqueRepo repo pid
|
||||||
|
return r
|
||||||
|
path <- askRepoDir user proj repo
|
||||||
|
pairs <- liftIO $ withRepo (fromString path) $ \ git -> do
|
||||||
|
oid <- resolveName git $ unpack $ repoMainBranch repository
|
||||||
|
graph <- loadCommitGraphPT git [oid]
|
||||||
|
let mnodes = topsortUnmixOrder graph (NodeStack [noNodes graph])
|
||||||
|
nodes = case mnodes of
|
||||||
|
Nothing -> error "commit graph contains a cycle"
|
||||||
|
Just ns -> ns
|
||||||
|
return $ D.toList $ fmap (nodeLabel graph) nodes
|
||||||
|
now <- liftIO dateCurrent
|
||||||
|
let toText = decodeUtf8With lenientDecode
|
||||||
|
mkrow oid commit =
|
||||||
|
( toText $ personName $ commitAuthor commit
|
||||||
|
, toText $ toHex $ unObjId oid
|
||||||
|
, toText $ takeLine $ commitMessage commit
|
||||||
|
, timeAgo' now (timeConvert $ personTime $ commitAuthor commit)
|
||||||
|
)
|
||||||
|
rows = map (uncurry mkrow) pairs
|
||||||
|
defaultLayout $ do
|
||||||
|
setTitle $ toHtml $ intercalate " > " $
|
||||||
|
["Vervis", "People", user, "Projects", proj, "Repos", repo, "Commits"]
|
||||||
|
$(widgetFile "repo/commits")
|
||||||
|
|
Loading…
Reference in a new issue