Commit info display, no diff diplay yet

src/Vervis/Git.hs

@@ -17,6 +17,7 @@ module Vervis.Git
     ( readSourceView
     , readChangesView
     , listRefs
+    , readPatch
     )
 where
 
@@ -26,7 +27,8 @@ import Data.Foldable (find)
 import Data.Git
 import Data.Git.Graph
 import Data.Git.Harder
-import Data.Git.Ref (toHex)
+import Data.Git.Ref (fromHex, toHex)
+import Data.Git.Repository (getCommit)
 import Data.Git.Storage (getObject_)
 import Data.Git.Storage.Object (Object (..))
 import Data.Git.Types (GitTime (..))
@@ -35,16 +37,18 @@ import Data.Graph.Inductive.Query.Topsort
 import Data.Set (Set)
 import Data.String (fromString)
 import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
+import Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import Data.Time.Clock ()
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Data.Traversable (for)
 import System.Hourglass (timeCurrent)
+import Text.Email.Validate (emailAddress)
 import Time.Types (Elapsed (..), Seconds (..))
 
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import qualified Data.DList as D (DList, empty, snoc, toList)
 import qualified Data.Set as S (member, mapMonotonic)
-import qualified Data.Text as T (pack, unpack)
+import qualified Data.Text as T (pack, unpack, break, strip)
 import qualified Data.Text.Encoding as TE (decodeUtf8With)
 import qualified Data.Text.Encoding.Error as TE (lenientDecode)
 
@@ -53,6 +57,7 @@ import Data.EventTime.Local
 import Data.Git.Local
 import Vervis.Changes
 import Vervis.Foundation (Widget)
+import Vervis.Patch
 import Vervis.Readme
 import Vervis.SourceTree
 
@@ -174,3 +179,40 @@ readChangesView path ref off lim = withRepo (fromString path) $ \ git -> do
 listRefs :: FilePath -> IO (Set Text, Set Text)
 listRefs path = withRepo (fromString path) $ \ git ->
     (,) <$> listBranches git <*> listTags git
+
+patch :: [Edit] -> Commit -> Patch
+patch edits c = Patch
+    { patchAuthorName  = decodeUtf8 $ personName $ commitAuthor c
+    , patchAuthorEmail =
+        let b = personEmail $ commitAuthor c
+        in  case emailAddress b of
+                Nothing -> error $ "Invalid email " ++ T.unpack (decodeUtf8 b)
+                Just e  -> e
+    , patchTime        =
+        let Elapsed (Seconds t) = gitTimeUTC $ personTime $ commitAuthor c
+        in  posixSecondsToUTCTime $ fromIntegral t
+    , patchTitle       = title
+    , patchDescription = desc
+    , patchDiff        = edits
+    }
+    where
+    split t =
+        let (l, r) = T.break (\ c -> c == '\n' || c == '\r') t
+        in  (T.strip l, T.strip r)
+    (title, desc) = split $ decodeUtf8 $ commitMessage c
+
+readPatch :: FilePath -> Text -> IO (Patch, [Text])
+readPatch path hash = withRepo (fromString path) $ \ git -> do
+    let ref = fromHex $ encodeUtf8 hash
+    c <- getCommit git ref
+    medits <- case commitParents c of
+        []  -> -- use the tree to generate list of AddFile diff parts
+                return $ Right []
+        [p] -> -- use getDiff to grab list of changes in the patch
+                return $ Right []
+        ps  -> -- multiple parents! idk rn how to deal with this correctly
+                fmap Left $ for ps $ \ p ->
+                    decodeUtf8 . takeLine . commitMessage <$> getCommit git p
+    return $ case medits of
+        Left parents -> (patch []    c, parents)
+        Right edits  -> (patch edits c, [])

src/Vervis/Handler/Repo.hs

@@ -263,8 +263,8 @@ getRepoPatchR :: ShrIdent -> RpIdent -> Text -> Handler Html
 getRepoPatchR shr rp ref = do
     repository <- runDB $ selectRepo shr rp
     case repoVcs repository of
-        VCSDarcs -> undefined -- getDarcsPatch shr rp ref
+        VCSDarcs -> error "Not implemented yet" -- getDarcsPatch shr rp ref
-        VCSGit -> undefined -- getGitRepoPatch shr rp ref
+        VCSGit -> getGitPatch shr rp ref
 
 getRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
 getRepoDevsR shr rp = do

src/Vervis/Handler/Repo/Git.hs

@@ -17,6 +17,7 @@ module Vervis.Handler.Repo.Git
     ( getGitRepoSource
     , getGitRepoHeadChanges
     , getGitRepoChanges
+    , getGitPatch
     )
 where
 
@@ -38,6 +39,7 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text, unpack)
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
+import Data.Traversable (for)
 import Database.Esqueleto
 import Data.Hourglass (timeConvert)
 import System.Directory (createDirectoryIfMissing)
@@ -46,6 +48,7 @@ import Text.Blaze.Html (Html)
 import Yesod.Core (defaultLayout)
 import Yesod.Core.Content (TypedContent)
 import Yesod.Core.Handler (selectRep, provideRep, notFound)
+import Yesod.Persist.Core (runDB, get404)
 import Yesod.AtomFeed (atomFeed)
 import Yesod.RssFeed (rssFeed)
 
@@ -65,16 +68,19 @@ import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Paginate
+import Vervis.Patch
 import Vervis.Readme
 import Vervis.Render
 import Vervis.Settings
 import Vervis.SourceTree
 import Vervis.Style
+import Vervis.Time (showDate)
 import Vervis.Widget.Repo
+import Vervis.Widget.Sharer (personLinkW)
 
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import qualified Data.Git.Local as G (createRepo)
-import qualified Vervis.Git as G (readSourceView, readChangesView, listRefs)
+import qualified Vervis.Git as G (readSourceView, readChangesView, listRefs, readPatch)
 
 getGitRepoSource :: Repo -> ShrIdent -> RpIdent -> Text -> [Text] -> Handler Html
 getGitRepoSource repository user repo ref dir = do
@@ -108,3 +114,12 @@ getGitRepoChanges shar repo ref = do
                 provideRep $ atomFeed feed
                 provideRep $ rssFeed feed
         else notFound
+
+getGitPatch :: ShrIdent -> RpIdent -> Text -> Handler Html
+getGitPatch shr rp ref = do
+    path <- askRepoDir shr rp
+    (patch, parents) <- liftIO $ G.readPatch path ref
+    msharer <- runDB $ do
+        mp <- getBy $ UniquePersonEmail $ patchAuthorEmail patch
+        for mp $ \ (Entity _ person) -> get404 $ personIdent person
+    defaultLayout $(widgetFile "repo/patch")

vervis.cabal

@@ -161,6 +161,7 @@ library
                        Vervis.Paginate
                        Vervis.Palette
                        Vervis.Path
+                       Vervis.Patch
                        Vervis.Query
                        Vervis.Readme
                        Vervis.Render