sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 11:14:51 +09:00
Code Issues Activity

Display any file and dir in the repo, not just top level

Browse source
This commit is contained in:
fr33domlover 2016-04-12 10:06:21 +00:00
parent 3c9d1eb095
commit 3325a9d960
2 changed files with 46 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
config/routes
View file

@ -50,7 +50,7 @@
/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/s/#Text/+Texts RepoSourceR GET
/u/#Text/p/#Text/r/#Text/c RepoCommitsR GET
-- /u/#Text/p/#Text/t TicketsR GET

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

@ -42,8 +42,9 @@ import Data.Git.Graph.Util
import Data.Git.Named (RefName (..))
import Data.Git.Ref (toHex)
import Data.Git.Repository
import Data.Git.Storage (withRepo)
import Data.Git.Types (Commit (..), Person (..))
import Data.Git.Storage (withRepo, getObject_)
import Data.Git.Storage.Object (Object (..))
import Data.Git.Types (Blob (..), Commit (..), Person (..), entName)
import Data.Graph.Inductive.Graph (noNodes)
import Data.Graph.Inductive.Query.Topsort
import Data.Text (unpack)
@ -56,6 +57,7 @@ import System.Hourglass (dateCurrent)
import qualified Data.DList as D
import qualified Data.Set as S (member)
import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
import Data.ByteString.Char8.Local (takeLine)
import Vervis.Form.Repo
@ -140,9 +142,11 @@ 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
getRepoSourceR :: Text -> Text -> Text -> Text -> [Text] -> Handler Html
getRepoSourceR user proj repo ref dir = do
path <- askRepoDir user proj repo
let toText = decodeUtf8With lenientDecode
toTextL = L.decodeUtf8With lenientDecode
minfo <- liftIO $ withRepo (fromString path) $ \ git -> do
branches <- branchList git
tags <- tagList git
@ -150,23 +154,36 @@ getRepoSourceR user proj repo ref = do
name' = RefName name
if name' `S.member` branches || name' `S.member` tags
then do
oid <- resolveName git name
mtree <- resolveTreeish git $ unObjId oid
tipOid <- resolveName git name
mtree <- resolveTreeish git $ unObjId tipOid
case mtree of
Nothing -> return Nothing
Just tree -> do
view <- viewTree git tree
let dir' = map (entName . encodeUtf8) dir
mRootOid <- resolveTreePath git tree dir'
target <- case mRootOid of
Nothing -> return $ Right tree
Just oid -> do
obj <- getObject_ git (unObjId oid) True
case obj of
ObjTree t -> return $ Right t
ObjBlob b -> return $ Left b
_ -> error "expected tree or blob"
view <- case target of
Left b -> Left <$> return b
Right t -> Right <$> viewTree git t
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) =
let mkrow (_perm, name, isTree) =
( if isTree then "[D]" else "[F]" :: Text
, toText $ toBytes name
)
rows = map mkrow view
display = case view of
Left b -> Left $ toTextL $ blobGetContent b
Right v -> Right $ map mkrow v
defaultLayout $ do
setTitle $ toHtml $ intercalate " > " $
["Vervis", "People", user, "Projects", proj, "Repos", repo]