RepoSourceR, display file tree for given branch or tag

config/routes

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

src/Vervis/Handler/Repo.hs

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