Implement git history log in repo page

config/models

@@ -45,11 +45,12 @@ Project
     UniqueProject ident sharer
 
 Repo
-    ident   Text       --CI
-    project ProjectId
-    desc    Text         Maybe
-    irc     IrcChannelId Maybe
-    ml      Text         Maybe
+    ident      Text       --CI
+    project    ProjectId
+    desc       Text         Maybe
+    irc        IrcChannelId Maybe
+    ml         Text         Maybe
+    mainBranch Text               default='master'
 
     UniqueRepo ident project
 

src/Data/ByteString/Char8/Local.hs

@@ -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

src/Data/Char/Local.hs

@@ -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'

src/Data/Git/Local.hs

@@ -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

src/Vervis/Form/Repo.hs

@@ -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

src/Vervis/Git.hs

@@ -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

src/Vervis/Handler/Repo.hs

@@ -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]

templates/repo.hamlet

@@ -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}

vervis.cabal

@@ -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