Darcs patch view, supporting only text file edit hunks so far

src/Vervis/Darcs.hs

@@ -260,7 +260,8 @@ joinHunks =
 -- | Read patch content, both metadata and the actual diff, from a given Darcs
 -- repository. Preconditions:
 --
--- * The repository is assumed to exist. If it doesn't, an exception is thrown.
+-- * The repo's existence has been verified against the DB
+-- * The repo dir is assumed to exist. If it doesn't, an exception is thrown.
 -- * The repository is assumed to be in a consistent state, all the expected
 --   inventory files and patch files and so on are assumed to exist and have
 --   the expected format. If not, an exception is thrown.

src/Vervis/Handler/Repo/Darcs.hs

@@ -30,6 +30,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 System.FilePath ((</>), joinPath)
 import System.Directory (doesFileExist)
@@ -37,6 +38,7 @@ import Text.Blaze.Html (Html)
 import Yesod.Core (defaultLayout, setTitle)
 import Yesod.Core.Content (TypedContent, typeOctet)
 import Yesod.Core.Handler (selectRep, provideRep, sendFile, notFound)
+import Yesod.Persist.Core (runDB, get404)
 import Yesod.AtomFeed (atomFeed)
 import Yesod.RssFeed (rssFeed)
 
@@ -56,16 +58,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
 import Vervis.Widget.Repo
+import Vervis.Widget.Sharer
 
 import qualified Darcs.Local.Repository as D (createRepo)
 import qualified Data.ByteString.Lazy as BL (ByteString)
-import qualified Vervis.Darcs as D (readSourceView, readChangesView)
+import qualified Vervis.Darcs as D (readSourceView, readChangesView, readPatch)
 
 getDarcsRepoSource :: Repo -> ShrIdent -> RpIdent -> [Text] -> Handler Html
 getDarcsRepoSource repository user repo dir = do
@@ -109,4 +114,15 @@ getDarcsDownloadR shar repo dir = do
         else notFound
 
 getDarcsPatch :: ShrIdent -> RpIdent -> Text -> Handler Html
-getDarcsPatch shr rp ref = error "Not implemented"
+getDarcsPatch shr rp ref = do
+    path <- askRepoDir shr rp
+    mpatch <- liftIO $ D.readPatch path ref
+    case mpatch of
+        Nothing -> notFound
+        Just patch -> do
+            let parents = [] :: [Text]
+            msharer <- runDB $ do
+                mp <- getBy $ UniquePersonEmail $ patchAuthorEmail patch
+                for mp $ \ (Entity _ person) -> get404 $ personIdent person
+            let number = zip ([1..] :: [Int])
+            defaultLayout $(widgetFile "repo/patch")