Display repo files in repo page instead of history log

src/Vervis/Handler/Repo.hs

@@ -35,10 +35,11 @@ import ClassyPrelude.Conduit       hiding (unpack)
 import Yesod                       hiding (Header, parseTime, (==.))
 import Yesod.Auth
 
+import Data.Byteable (toBytes)
 import Data.Git.Graph
 import Data.Git.Graph.Util
 import Data.Git.Ref (toHex)
-import Data.Git.Repository (initRepo)
+import Data.Git.Repository (initRepo, getCommit, getTree)
 import Data.Git.Storage (withRepo)
 import Data.Git.Types (Commit (..), Person (..))
 import Data.Graph.Inductive.Graph (noNodes)
@@ -120,23 +121,17 @@ getRepoR user proj repo = do
         Entity _rid r <- getBy404 $ UniqueRepo repo pid
         return r
     path <- askRepoDir user proj repo
-    pairs <- liftIO $ withRepo (fromString path) $ \ git -> do
+    view <- liftIO $ withRepo (fromString path) $ \ git -> do
         oid <- resolveName git $ unpack $ repoMainBranch repository
-        graph <- loadCommitGraphPT git [oid]
-        let mnodes = topsortUnmixOrder graph (NodeStack [noNodes graph])
-            nodes = case mnodes of
-                Nothing -> error "commit graph contains a cycle"
-                Just ns -> ns
-        return $ D.toList $ fmap (nodeLabel graph) nodes
-    now <- liftIO dateCurrent
+        commit <- getCommit git $ unObjId oid
+        tree <- getTree git $ commitTreeish commit
+        viewTree git tree
     let toText = decodeUtf8With lenientDecode
-        mkrow oid commit =
-            ( toText $ personName $ commitAuthor commit
-            , toText $ toHex $ unObjId oid
-            , toText $ takeLine $ commitMessage commit
-            , timeAgo' now (timeConvert $ personTime $ commitAuthor commit)
+        mkrow (_perm, name, isTree) =
+            ( if isTree then "[D]" else "[F]" :: Text
+            , toText $ toBytes name
             )
-        rows = map (uncurry mkrow) pairs
+        rows = map mkrow view
     defaultLayout $ do
         setTitle $ toHtml $ intercalate " > " $
             ["Vervis", "People", user, "Projects", proj, "Repos", repo]

stack.yaml

@@ -8,7 +8,8 @@ resolver: lts-5.11
 # Local packages, usually specified by relative directory name
 packages:
   - '.'
-  - '/home/fr33domlover/Repos/other-work/ssh'
+  - '../../../other-work/ssh'
+  - '../hit-graph'
 
 # Packages to be pulled from upstream that are not in the resolver (e.g.,
 # acme-missiles-0.3)

templates/repo/repo.hamlet

@@ -29,16 +29,12 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       $nothing
         (none)
 
-<h2>History
+<h2>Files
 <table>
   <tr>
-    <th>Author
-    <th>Hash
-    <th>Message
-    <th>Time
-  $forall (author, hash, message, time) <- rows
+    <th>Type
+    <th>Name
+  $forall (type', name) <- rows
     <tr>
-      <td>#{author}
-      <td>#{hash}
-      <td>#{message}
-      <td>#{time}
+      <td>#{type'}
+      <td>#{name}

vervis.cabal

@@ -87,6 +87,7 @@ library
                      , base64-bytestring
                      , binary
                      , blaze-html
+                     , byteable
                      , bytestring
                      , case-insensitive
                      , classy-prelude