forge/Vervis
1
0
Fork 0
Code Pull requests 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 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/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/r/#Text/c RepoCommitsR GET
-- /u/#Text/p/#Text/t TicketsR 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.Named (RefName (..))
import Data.Git.Ref (toHex) import Data.Git.Ref (toHex)
import Data.Git.Repository import Data.Git.Repository
import Data.Git.Storage (withRepo) import Data.Git.Storage (withRepo, getObject_)
import Data.Git.Types (Commit (..), Person (..)) import Data.Git.Storage.Object (Object (..))
import Data.Git.Types (Blob (..), Commit (..), Person (..), entName)
import Data.Graph.Inductive.Graph (noNodes) import Data.Graph.Inductive.Graph (noNodes)
import Data.Graph.Inductive.Query.Topsort import Data.Graph.Inductive.Query.Topsort
import Data.Text (unpack) import Data.Text (unpack)
@ -56,6 +57,7 @@ import System.Hourglass (dateCurrent)
import qualified Data.DList as D import qualified Data.DList as D
import qualified Data.Set as S (member) import qualified Data.Set as S (member)
import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
import Data.ByteString.Char8.Local (takeLine) import Data.ByteString.Char8.Local (takeLine)
import Vervis.Form.Repo import Vervis.Form.Repo
@ -140,9 +142,11 @@ getRepoR user proj repo = do
["Vervis", "People", user, "Projects", proj, "Repos", repo] ["Vervis", "People", user, "Projects", proj, "Repos", repo]
$(widgetFile "repo/repo") $(widgetFile "repo/repo")
getRepoSourceR :: Text -> Text -> Text -> Text -> Handler Html getRepoSourceR :: Text -> Text -> Text -> Text -> [Text] -> Handler Html
getRepoSourceR user proj repo ref = do getRepoSourceR user proj repo ref dir = do
path <- askRepoDir user proj repo path <- askRepoDir user proj repo
let toText = decodeUtf8With lenientDecode
toTextL = L.decodeUtf8With lenientDecode
minfo <- liftIO $ withRepo (fromString path) $ \ git -> do minfo <- liftIO $ withRepo (fromString path) $ \ git -> do
branches <- branchList git branches <- branchList git
tags <- tagList git tags <- tagList git
@ -150,23 +154,36 @@ getRepoSourceR user proj repo ref = do
name' = RefName name name' = RefName name
if name' `S.member` branches || name' `S.member` tags if name' `S.member` branches || name' `S.member` tags
then do then do
oid <- resolveName git name tipOid <- resolveName git name
mtree <- resolveTreeish git $ unObjId oid mtree <- resolveTreeish git $ unObjId tipOid
case mtree of case mtree of
Nothing -> return Nothing Nothing -> return Nothing
Just tree -> do 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) return $ Just (branches, tags, view)
else return Nothing else return Nothing
case minfo of case minfo of
Nothing -> notFound Nothing -> notFound
Just (branches, tags, view) -> do Just (branches, tags, view) -> do
let toText = decodeUtf8With lenientDecode let mkrow (_perm, name, isTree) =
mkrow (_perm, name, isTree) =
( if isTree then "[D]" else "[F]" :: Text ( if isTree then "[D]" else "[F]" :: Text
, toText $ toBytes name , 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 defaultLayout $ do
setTitle $ toHtml $ intercalate " > " $ setTitle $ toHtml $ intercalate " > " $
["Vervis", "People", user, "Projects", proj, "Repos", repo] ["Vervis", "People", user, "Projects", proj, "Repos", repo]