diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index 6f467d8..5caa352 100644 --- a/src/Vervis/Git.hs +++ b/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, []) diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 6999593..14f3952 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/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 - VCSGit -> undefined -- getGitRepoPatch shr rp ref + VCSDarcs -> error "Not implemented yet" -- getDarcsPatch shr rp ref + VCSGit -> getGitPatch shr rp ref getRepoDevsR :: ShrIdent -> RpIdent -> Handler Html getRepoDevsR shr rp = do diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Handler/Repo/Git.hs index bb7be6d..c2440ea 100644 --- a/src/Vervis/Handler/Repo/Git.hs +++ b/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") diff --git a/vervis.cabal b/vervis.cabal index 3962c70..a2fa926 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -161,6 +161,7 @@ library Vervis.Paginate Vervis.Palette Vervis.Path + Vervis.Patch Vervis.Query Vervis.Readme Vervis.Render