Commit info display, no diff diplay yet

This commit is contained in:
fr33domlover 2018-05-17 23:33:37 +00:00
parent ce89bded73
commit 6d97636b0f
4 changed files with 64 additions and 6 deletions

View file

@ -17,6 +17,7 @@ module Vervis.Git
( readSourceView ( readSourceView
, readChangesView , readChangesView
, listRefs , listRefs
, readPatch
) )
where where
@ -26,7 +27,8 @@ import Data.Foldable (find)
import Data.Git import Data.Git
import Data.Git.Graph import Data.Git.Graph
import Data.Git.Harder 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 (getObject_)
import Data.Git.Storage.Object (Object (..)) import Data.Git.Storage.Object (Object (..))
import Data.Git.Types (GitTime (..)) import Data.Git.Types (GitTime (..))
@ -35,16 +37,18 @@ import Data.Graph.Inductive.Query.Topsort
import Data.Set (Set) import Data.Set (Set)
import Data.String (fromString) import Data.String (fromString)
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Time.Clock () import Data.Time.Clock ()
import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Traversable (for)
import System.Hourglass (timeCurrent) import System.Hourglass (timeCurrent)
import Text.Email.Validate (emailAddress)
import Time.Types (Elapsed (..), Seconds (..)) import Time.Types (Elapsed (..), Seconds (..))
import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)
import qualified Data.DList as D (DList, empty, snoc, toList) import qualified Data.DList as D (DList, empty, snoc, toList)
import qualified Data.Set as S (member, mapMonotonic) 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 as TE (decodeUtf8With)
import qualified Data.Text.Encoding.Error as TE (lenientDecode) import qualified Data.Text.Encoding.Error as TE (lenientDecode)
@ -53,6 +57,7 @@ import Data.EventTime.Local
import Data.Git.Local import Data.Git.Local
import Vervis.Changes import Vervis.Changes
import Vervis.Foundation (Widget) import Vervis.Foundation (Widget)
import Vervis.Patch
import Vervis.Readme import Vervis.Readme
import Vervis.SourceTree 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 :: FilePath -> IO (Set Text, Set Text)
listRefs path = withRepo (fromString path) $ \ git -> listRefs path = withRepo (fromString path) $ \ git ->
(,) <$> listBranches git <*> listTags 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, [])

View file

@ -263,8 +263,8 @@ getRepoPatchR :: ShrIdent -> RpIdent -> Text -> Handler Html
getRepoPatchR shr rp ref = do getRepoPatchR shr rp ref = do
repository <- runDB $ selectRepo shr rp repository <- runDB $ selectRepo shr rp
case repoVcs repository of 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 :: ShrIdent -> RpIdent -> Handler Html
getRepoDevsR shr rp = do getRepoDevsR shr rp = do

View file

@ -17,6 +17,7 @@ module Vervis.Handler.Repo.Git
( getGitRepoSource ( getGitRepoSource
, getGitRepoHeadChanges , getGitRepoHeadChanges
, getGitRepoChanges , getGitRepoChanges
, getGitPatch
) )
where where
@ -38,6 +39,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 Data.Hourglass (timeConvert) import Data.Hourglass (timeConvert)
import System.Directory (createDirectoryIfMissing) import System.Directory (createDirectoryIfMissing)
@ -46,6 +48,7 @@ import Text.Blaze.Html (Html)
import Yesod.Core (defaultLayout) import Yesod.Core (defaultLayout)
import Yesod.Core.Content (TypedContent) import Yesod.Core.Content (TypedContent)
import Yesod.Core.Handler (selectRep, provideRep, notFound) import Yesod.Core.Handler (selectRep, provideRep, notFound)
import Yesod.Persist.Core (runDB, get404)
import Yesod.AtomFeed (atomFeed) import Yesod.AtomFeed (atomFeed)
import Yesod.RssFeed (rssFeed) import Yesod.RssFeed (rssFeed)
@ -65,16 +68,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 (showDate)
import Vervis.Widget.Repo import Vervis.Widget.Repo
import Vervis.Widget.Sharer (personLinkW)
import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)
import qualified Data.Git.Local as G (createRepo) 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 :: Repo -> ShrIdent -> RpIdent -> Text -> [Text] -> Handler Html
getGitRepoSource repository user repo ref dir = do getGitRepoSource repository user repo ref dir = do
@ -108,3 +114,12 @@ getGitRepoChanges shar repo ref = do
provideRep $ atomFeed feed provideRep $ atomFeed feed
provideRep $ rssFeed feed provideRep $ rssFeed feed
else notFound 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")

View file

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