feat: implement raw file browsing

src/Vervis/Foundation.hs

@@ -911,6 +911,7 @@ instance YesodBreadcrumbs App where
         RepoSourceR r dir         -> (last dir, Just $ RepoSourceR r $ init dir)
         RepoBranchSourceR r b []  -> ("Branch " <> b <> " Files", Just $ RepoR r)
         RepoBranchSourceR r b dir -> (last dir, Just $ RepoBranchSourceR r b $ init dir)
+        RepoBranchRawR r b dir    -> ("", Nothing)
         RepoCommitsR r            -> ("Commits", Just $ RepoR r)
         RepoBranchCommitsR r b    -> ("Branch " <> b <> " Commits", Just $ RepoR r)
         RepoCommitR r c           -> (c, Just $ RepoCommitsR r)

src/Vervis/Git.hs

@@ -16,6 +16,7 @@
 
 module Vervis.Git
     ( readSourceView
+    , readRawView
     , readChangesView
     , listRefs
     , readPatch
@@ -175,6 +176,24 @@ readSourceView path ref dir = do
     let toTexts = S.mapMonotonic $ T.pack . refNameRaw
     return (toTexts bs, toTexts ts, renderSources dir <$> msv)
 
+readRawView
+    :: FilePath
+    -- ^ Repository path
+    -> Text
+    -- ^ Name of branch or tag
+    -> [Text]
+    -- ^ Path in the source tree pointing to a file or directory
+    -> IO (Maybe BL.ByteString)
+    -- ^ Raw content of the file
+readRawView path ref dir = do
+    (_, _, msv) <-
+        G.withRepo (fromString path) $ \ git -> loadSourceView git ref dir
+    case msv of
+        -- Returns the content of the regular file
+        Just (SourceFile (FileView _ body)) -> return $ Just body
+        -- Returns Nothing o.w. including root and directory
+        _ -> return Nothing
+
 readChangesView
     :: FilePath
     -- ^ Repository path

src/Vervis/Handler/Repo.hs

@@ -28,6 +28,7 @@ module Vervis.Handler.Repo
 
     , getRepoSourceR
     , getRepoBranchSourceR
+    , getRepoBranchRawR
     , getRepoCommitsR
     , getRepoBranchCommitsR
     , getRepoCommitR
@@ -402,6 +403,14 @@ getRepoBranchSourceR repoHash branch path = do
         VCSDarcs -> notFound
         VCSGit -> getGitRepoSource repo actor repoHash branch path looms
 
+getRepoBranchRawR :: KeyHashid Repo -> Text -> [Text] -> Handler TypedContent
+getRepoBranchRawR repoHash branch path = do
+    repoID <- decodeKeyHashid404 repoHash
+    repo <- runDB $ get404 repoID
+    case repoVcs repo of
+        VCSDarcs -> notFound
+        VCSGit -> getGitRepoRaw repoHash branch path
+
 getRepoCommitsR :: KeyHashid Repo -> Handler TypedContent
 getRepoCommitsR repoHash = do
     repoID <- decodeKeyHashid404 repoHash

src/Vervis/Web/Git.hs

@@ -16,6 +16,7 @@
 
 module Vervis.Web.Git
     ( getGitRepoSource
+    , getGitRepoRaw
     --, getGitRepoBranch
     , getGitRepoChanges
     , getGitPatch
@@ -123,6 +124,17 @@ getGitRepoSource repository actor repo ref dir loomIDs = do
     followButton =
         followW (RepoFollowR repo) (RepoUnfollowR repo) (actorFollowers actor)
 
+getGitRepoRaw
+    :: KeyHashid Repo -> Text -> [Text] -> Handler TypedContent
+getGitRepoRaw repo ref dir = do
+    path <- askRepoDir repo
+    msv <- liftIO $ G.readRawView path ref dir
+    case msv of
+        Nothing -> notFound
+        Just body -> return $
+            TypedContent typePlain $ -- TODO correct MIME type
+            toContent body
+
 {-
 getGitRepoBranch :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
 getGitRepoBranch shar repo ref = do

th/routes

@@ -193,6 +193,7 @@
 
 /repos/#RepoKeyHashid/source/+Texts               RepoSourceR        GET
 /repos/#RepoKeyHashid/source-by/#Text/+Texts      RepoBranchSourceR  GET
+/repos/#RepoKeyHashid/raw/#Text/+Texts            RepoBranchRawR     GET
 /repos/#RepoKeyHashid/commits                     RepoCommitsR       GET
 /repos/#RepoKeyHashid/commits-by/#Text            RepoBranchCommitsR GET
 /repos/#RepoKeyHashid/commits/#Text               RepoCommitR        GET