From 100ba7511c8f56e01218a19aba18496786f70961 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Tue, 12 Apr 2016 00:19:04 +0000
Subject: [PATCH] RepoSourceR, display file tree for given branch or tag

---
 config/routes              | 37 +++++++++++++++++++------------------
 src/Vervis/Handler/Repo.hs | 37 ++++++++++++++++++++++++++++++++++++-
 2 files changed, 55 insertions(+), 19 deletions(-)

diff --git a/config/routes b/config/routes
index d6a8f71..7d0d450 100644
--- a/config/routes
+++ b/config/routes
@@ -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
diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs
index 0981a35..0f7d5f6 100644
--- a/src/Vervis/Handler/Repo.hs
+++ b/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