sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 17:54:53 +09:00
Code Issues Activity

RepoSourceR, display file tree for given branch or tag

Browse source
This commit is contained in:
fr33domlover 2016-04-12 00:19:04 +00:00
parent b312d41ef0
commit 100ba7511c
2 changed files with 55 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
config/routes
View file

@ -16,41 +16,42 @@
-- Yesod misc
-- ----------------------------------------------------------------------------
/static StaticR Static appStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/static StaticR Static appStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
-- ----------------------------------------------------------------------------
-- User login
-- ----------------------------------------------------------------------------
/auth AuthR Auth getAuth
/auth AuthR Auth getAuth
-- ----------------------------------------------------------------------------
-- Everything else...
-- ----------------------------------------------------------------------------
/ HomeR GET
/ HomeR GET
/u PeopleR GET POST
/u/!new PersonNewR GET
/u/#Text PersonR GET
/u PeopleR GET POST
/u/!new PersonNewR GET
/u/#Text PersonR GET
/u/#Text/k KeysR GET POST
/u/#Text/k/!new KeyNewR GET
/u/#Text/k/#Text KeyR GET
/u/#Text/k KeysR GET POST
/u/#Text/k/!new KeyNewR GET
/u/#Text/k/#Text KeyR GET
/u/#Text/p ProjectsR GET POST
/u/#Text/p/!new ProjectNewR GET
/u/#Text/p/#Text ProjectR GET
/u/#Text/p ProjectsR GET POST
/u/#Text/p/!new ProjectNewR GET
/u/#Text/p/#Text ProjectR GET
-- 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
-- independently of projects...
/u/#Text/p/#Text/r ReposR GET POST
/u/#Text/p/#Text/r/!new RepoNewR GET
/u/#Text/p/#Text/r/#Text RepoR GET
/u/#Text/p/#Text/r/#Text/c RepoCommitsR GET
/u/#Text/p/#Text/r ReposR GET POST
/u/#Text/p/#Text/r/!new RepoNewR GET
/u/#Text/p/#Text/r/#Text RepoR GET
/u/#Text/p/#Text/r/#Text/s/#Text RepoSourceR GET
/u/#Text/p/#Text/r/#Text/c RepoCommitsR GET
-- /u/#Text/p/#Text/t TicketsR GET
-- /u/#Text/p/#Text/t/#TicketId TicketR GET

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

@ -18,6 +18,7 @@ module Vervis.Handler.Repo
, postReposR
, getRepoNewR
, getRepoR
, getRepoSourceR
, getRepoCommitsR
)
where
@ -38,8 +39,9 @@ import Yesod.Auth
import Data.Byteable (toBytes)
import Data.Git.Graph
import Data.Git.Graph.Util
import Data.Git.Named (RefName (..))
import Data.Git.Ref (toHex)
import Data.Git.Repository (initRepo, getCommit, getTree)
import Data.Git.Repository
import Data.Git.Storage (withRepo)
import Data.Git.Types (Commit (..), Person (..))
import Data.Graph.Inductive.Graph (noNodes)
@ -53,6 +55,7 @@ import System.Directory (createDirectoryIfMissing)
import System.Hourglass (dateCurrent)
import qualified Data.DList as D
import qualified Data.Set as S (member)
import Data.ByteString.Char8.Local (takeLine)
import Vervis.Form.Repo
@ -137,6 +140,38 @@ getRepoR user proj repo = do
["Vervis", "People", user, "Projects", proj, "Repos", repo]
$(widgetFile "repo/repo")
getRepoSourceR :: Text -> Text -> Text -> Text -> Handler Html
getRepoSourceR user proj repo ref = do
path <- askRepoDir user proj repo
minfo <- liftIO $ withRepo (fromString path) $ \ git -> do
branches <- branchList git
tags <- tagList git
let name = unpack ref
name' = RefName name
if name' `S.member` branches || name' `S.member` tags
then do
oid <- resolveName git name
mtree <- resolveTreeish git $ unObjId oid
case mtree of
Nothing -> return Nothing
Just tree -> do
view <- viewTree git tree
return $ Just (branches, tags, view)
else return Nothing
case minfo of
Nothing -> notFound
Just (branches, tags, view) -> do
let toText = decodeUtf8With lenientDecode
mkrow (_perm, name, isTree) =
( if isTree then "[D]" else "[F]" :: Text
, toText $ toBytes name
)
rows = map mkrow view
defaultLayout $ do
setTitle $ toHtml $ intercalate " > " $
["Vervis", "People", user, "Projects", proj, "Repos", repo]
$(widgetFile "repo/source")
getRepoCommitsR :: Text -> Text -> Text -> Handler Html
getRepoCommitsR user proj repo = do
repository <- runDB $ do