1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 18:14:52 +09:00

Display repo files in repo page instead of history log

This commit is contained in:
fr33domlover 2016-04-11 22:13:32 +00:00
parent fa4e4294b1
commit 9e9e7fc803
4 changed files with 19 additions and 26 deletions

View file

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

View file

@ -8,7 +8,8 @@ resolver: lts-5.11
# Local packages, usually specified by relative directory name # Local packages, usually specified by relative directory name
packages: 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., # Packages to be pulled from upstream that are not in the resolver (e.g.,
# acme-missiles-0.3) # acme-missiles-0.3)

View file

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

View file

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