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

This commit is contained in:
fr33domlover 2018-07-10 14:02:30 +00:00
parent 13bd369de3
commit a50de1fe88
2 changed files with 20 additions and 3 deletions

View file

@ -260,7 +260,8 @@ joinHunks =
-- | Read patch content, both metadata and the actual diff, from a given Darcs -- | Read patch content, both metadata and the actual diff, from a given Darcs
-- repository. Preconditions: -- 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 -- * 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 -- inventory files and patch files and so on are assumed to exist and have
-- the expected format. If not, an exception is thrown. -- the expected format. If not, an exception is thrown.

View file

@ -30,6 +30,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
import Data.Traversable (for)
import Database.Esqueleto import Database.Esqueleto
import System.FilePath ((</>), joinPath) import System.FilePath ((</>), joinPath)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
@ -37,6 +38,7 @@ import Text.Blaze.Html (Html)
import Yesod.Core (defaultLayout, setTitle) import Yesod.Core (defaultLayout, setTitle)
import Yesod.Core.Content (TypedContent, typeOctet) import Yesod.Core.Content (TypedContent, typeOctet)
import Yesod.Core.Handler (selectRep, provideRep, sendFile, notFound) import Yesod.Core.Handler (selectRep, provideRep, sendFile, notFound)
import Yesod.Persist.Core (runDB, get404)
import Yesod.AtomFeed (atomFeed) import Yesod.AtomFeed (atomFeed)
import Yesod.RssFeed (rssFeed) import Yesod.RssFeed (rssFeed)
@ -56,16 +58,19 @@ import Vervis.Model
import Vervis.Model.Ident import Vervis.Model.Ident
import Vervis.Model.Repo import Vervis.Model.Repo
import Vervis.Paginate import Vervis.Paginate
import Vervis.Patch
import Vervis.Readme import Vervis.Readme
import Vervis.Render import Vervis.Render
import Vervis.Settings import Vervis.Settings
import Vervis.SourceTree import Vervis.SourceTree
import Vervis.Style import Vervis.Style
import Vervis.Time
import Vervis.Widget.Repo import Vervis.Widget.Repo
import Vervis.Widget.Sharer
import qualified Darcs.Local.Repository as D (createRepo) import qualified Darcs.Local.Repository as D (createRepo)
import qualified Data.ByteString.Lazy as BL (ByteString) 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 :: Repo -> ShrIdent -> RpIdent -> [Text] -> Handler Html
getDarcsRepoSource repository user repo dir = do getDarcsRepoSource repository user repo dir = do
@ -109,4 +114,15 @@ getDarcsDownloadR shar repo dir = do
else notFound else notFound
getDarcsPatch :: ShrIdent -> RpIdent -> Text -> Handler Html 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")