forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Add repo commits route

Browse source
This commit is contained in:
fr33domlover 2016-04-11 21:35:26 +00:00
parent 4c32d038b3
commit fa4e4294b1
2 changed files with 49 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
config/routes
View file

@ -16,40 +16,41 @@
-- Yesod misc -- Yesod misc
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
/static StaticR Static appStatic /static StaticR Static appStatic
/favicon.ico FaviconR GET /favicon.ico FaviconR GET
/robots.txt RobotsR GET /robots.txt RobotsR GET
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
-- User login -- User login
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
/auth AuthR Auth getAuth /auth AuthR Auth getAuth
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
-- Everything else... -- Everything else...
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
/ HomeR GET / HomeR GET
/u PeopleR GET POST /u PeopleR GET POST
/u/!new PersonNewR GET /u/!new PersonNewR GET
/u/#Text PersonR GET /u/#Text PersonR GET
/u/#Text/k KeysR GET POST /u/#Text/k KeysR GET POST
/u/#Text/k/!new KeyNewR GET /u/#Text/k/!new KeyNewR GET
/u/#Text/k/#Text KeyR GET /u/#Text/k/#Text KeyR GET
/u/#Text/p ProjectsR GET POST /u/#Text/p ProjectsR GET POST
/u/#Text/p/!new ProjectNewR GET /u/#Text/p/!new ProjectNewR GET
/u/#Text/p/#Text ProjectR GET /u/#Text/p/#Text ProjectR GET
-- IDEA: if there's /u/john/p/proj/r/repo, then make /u/john/r/proj-repo -- IDEA: if there's /u/john/p/proj/r/repo, then make /u/john/r/proj-repo
-- redirect there. consider having a clean way to refer to repos -- redirect there. consider having a clean way to refer to repos
-- independently of projects... -- independently of projects...
/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

31
src/Vervis/Handler/Repo.hs
View file

@ -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")