Implement git history log in repo page
This commit is contained in:
parent
100d2948cb
commit
b20c672a01
9 changed files with 97 additions and 28 deletions
|
@ -50,6 +50,7 @@ Repo
|
|||
desc Text Maybe
|
||||
irc IrcChannelId Maybe
|
||||
ml Text Maybe
|
||||
mainBranch Text default='master'
|
||||
|
||||
UniqueRepo ident project
|
||||
|
||||
|
|
28
src/Data/ByteString/Char8/Local.hs
Normal file
28
src/Data/ByteString/Char8/Local.hs
Normal file
|
@ -0,0 +1,28 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
- The author(s) have dedicated all copyright and related and neighboring
|
||||
- rights to this software to the public domain worldwide. This software is
|
||||
- distributed without any warranty.
|
||||
-
|
||||
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||
- with this software. If not, see
|
||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
-}
|
||||
|
||||
module Data.ByteString.Char8.Local
|
||||
( takeLine
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude hiding (takeWhile)
|
||||
|
||||
import Data.ByteString.Char8
|
||||
|
||||
import Data.Char.Local (isNewline)
|
||||
|
||||
takeLine :: ByteString -> ByteString
|
||||
takeLine = takeWhile $ not . isNewline
|
|
@ -15,6 +15,7 @@
|
|||
|
||||
module Data.Char.Local
|
||||
( isAsciiLetter
|
||||
, isNewline
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -22,3 +23,6 @@ import Prelude
|
|||
|
||||
isAsciiLetter :: Char -> Bool
|
||||
isAsciiLetter c = 'A' <= c && c <= 'Z' || 'a' <= c && c <= 'z'
|
||||
|
||||
isNewline :: Char -> Bool
|
||||
isNewline c = c == '\n' || c == '\r'
|
||||
|
|
|
@ -154,7 +154,7 @@ loadCommitGraphByName :: Graph g => Git -> String -> IO (CommitGraph g)
|
|||
loadCommitGraphByName git name = do
|
||||
mg <- loadCommitGraphByNameMaybe git name
|
||||
case mg of
|
||||
Nothing -> error ""
|
||||
Nothing -> error "no such ref"
|
||||
Just g -> return g
|
||||
|
||||
-- | Load a commit graph and topsort the commits. The resulting list starts
|
||||
|
|
|
@ -28,6 +28,7 @@ newRepoAForm sid pid = Repo
|
|||
<*> aopt textField "Description" Nothing
|
||||
<*> pure Nothing
|
||||
<*> pure Nothing
|
||||
<*> pure "master"
|
||||
|
||||
newRepoForm :: SharerId -> ProjectId -> Form Repo
|
||||
newRepoForm sid pid = renderDivs $ newRepoAForm sid pid
|
||||
|
|
|
@ -20,6 +20,7 @@
|
|||
module Vervis.Git
|
||||
( lastChange
|
||||
, timeAgo
|
||||
, timeAgo'
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -114,20 +115,10 @@ fromSec sec =
|
|||
timeAgo :: DateTime -> IO Text
|
||||
timeAgo dt = do
|
||||
now <- dateCurrent
|
||||
return $ timeAgo' now dt
|
||||
|
||||
timeAgo' :: DateTime -> DateTime -> Text
|
||||
timeAgo' now dt =
|
||||
let sec = timeDiff now dt
|
||||
(period, duration) = fromSec sec
|
||||
return $ showAgo period duration
|
||||
|
||||
{-commits' :: Git -> Ref -> Int -> IO [(Text, Text, Text, Text)]
|
||||
commits' git r l = go r l
|
||||
where
|
||||
go _ 0 = return []
|
||||
go ref lim = do
|
||||
commit <- getCommit git ref
|
||||
|
||||
commits :: Git -> String -> Int -> IO [(Text, Text, Text, Text)]
|
||||
commits git branch lim = do
|
||||
mref <- resolveRevision git $ Revision branch []
|
||||
case mref of
|
||||
Nothing -> return []
|
||||
Just ref -> commits' git ref lim-}
|
||||
in showAgo period duration
|
||||
|
|
|
@ -28,14 +28,32 @@ where
|
|||
-- [x] add new repo creation link
|
||||
-- [x] make new repo form
|
||||
-- [x] write the git and mkdir parts that actually create the repo
|
||||
-- [ ] make repo view that shows a table of commits
|
||||
-- [x] make repo view that shows a table of commits
|
||||
|
||||
import ClassyPrelude.Conduit hiding (unpack)
|
||||
import Yesod hiding (Header, parseTime, (==.))
|
||||
import Yesod.Auth
|
||||
|
||||
import Data.Git.Ref (toHex)
|
||||
import Data.Git.Repository (initRepo)
|
||||
import Data.Git.Storage (withRepo)
|
||||
import Data.Git.Types (Commit (..), Person (..))
|
||||
import Data.Text (unpack)
|
||||
import Data.Text.Encoding (decodeUtf8With)
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import Database.Esqueleto
|
||||
import Data.Hourglass (timeConvert)
|
||||
import System.Directory (createDirectoryIfMissing)
|
||||
--import System.FilePath ((</>))
|
||||
import Vervis.Import hiding ((==.))
|
||||
import System.Hourglass (dateCurrent)
|
||||
|
||||
import Data.ByteString.Char8.Local (takeLine)
|
||||
import Data.Git.Local (loadCommitsTopsortList)
|
||||
import Vervis.Form.Repo
|
||||
import Vervis.Foundation
|
||||
import Vervis.Git (timeAgo')
|
||||
import Vervis.Path
|
||||
import Vervis.Model
|
||||
import Vervis.Settings
|
||||
|
||||
getReposR :: Text -> Text -> Handler Html
|
||||
getReposR user proj = do
|
||||
|
@ -59,9 +77,8 @@ postReposR user proj = do
|
|||
((result, widget), enctype) <- runFormPost $ newRepoForm sid pid
|
||||
case result of
|
||||
FormSuccess repo -> do
|
||||
root <- appRepoDir . appSettings <$> getYesod
|
||||
let parent = root </> unpack user </> unpack proj
|
||||
path = parent </> unpack (repoIdent repo)
|
||||
parent <- askProjectDir user proj
|
||||
let path = parent </> unpack (repoIdent repo)
|
||||
liftIO $ createDirectoryIfMissing True parent
|
||||
liftIO $ initRepo $ fromString path
|
||||
runDB $ insert_ repo
|
||||
|
@ -92,6 +109,18 @@ getRepoR user proj repo = do
|
|||
Entity pid _p <- getBy404 $ UniqueProject proj sid
|
||||
Entity _rid r <- getBy404 $ UniqueRepo repo pid
|
||||
return r
|
||||
path <- askRepoDir user proj repo
|
||||
pairs <- liftIO $ withRepo (fromString path) $ \ git ->
|
||||
loadCommitsTopsortList git $ unpack $ repoMainBranch repository
|
||||
now <- liftIO dateCurrent
|
||||
let toText = decodeUtf8With lenientDecode
|
||||
mkrow ref commit =
|
||||
( toText $ personName $ commitAuthor commit
|
||||
, toText $ toHex ref
|
||||
, toText $ takeLine $ commitMessage commit
|
||||
, timeAgo' now (timeConvert $ personTime $ commitAuthor commit)
|
||||
)
|
||||
rows = map (uncurry mkrow) pairs
|
||||
defaultLayout $ do
|
||||
setTitle $ toHtml $ intercalate " > " $
|
||||
["Vervis", "People", user, "Projects", proj, "Repos", repo]
|
||||
|
|
|
@ -28,3 +28,17 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
#{desc}
|
||||
$nothing
|
||||
(none)
|
||||
|
||||
<h2>History
|
||||
<table>
|
||||
<tr>
|
||||
<th>Author
|
||||
<th>Hash
|
||||
<th>Message
|
||||
<th>Time
|
||||
$forall (author, hash, message, time) <- rows
|
||||
<tr>
|
||||
<td>#{author}
|
||||
<td>#{hash}
|
||||
<td>#{message}
|
||||
<td>#{time}
|
||||
|
|
|
@ -34,7 +34,8 @@ flag library-only
|
|||
default: False
|
||||
|
||||
library
|
||||
exposed-modules: Data.Char.Local
|
||||
exposed-modules: Data.ByteString.Char8.Local
|
||||
Data.Char.Local
|
||||
Data.Git.Local
|
||||
Data.Graph.Inductive.Local
|
||||
Data.List.Local
|
||||
|
|
Loading…
Reference in a new issue