{- This file is part of Vervis. - - Written in 2016, 2018, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} module Vervis.Handler.Repo.Git ( getGitRepoSource , getGitRepoHeadChanges , getGitRepoChanges , getGitPatch ) where import Prelude import Control.Monad.IO.Class (liftIO) import Data.Git.Graph import Data.Git.Harder import Data.Git.Named (RefName (..)) import Data.Git.Ref (toHex) import Data.Git.Repository import Data.Git.Storage (withRepo) import Data.Git.Storage.Object (Object (..)) import Data.Git.Types (Blob (..), Commit (..), Person (..), entName) import Data.Graph.Inductive.Graph (noNodes) import Data.Graph.Inductive.Query.Topsort import Data.List (inits) 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 Network.HTTP.Types (StdMethod (DELETE)) import System.Directory (createDirectoryIfMissing) import System.Hourglass (dateCurrent) 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) import qualified Data.DList as D import qualified Data.Set as S (member) import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With) import Data.ByteString.Char8.Local (takeLine) import Data.Git.Local import Text.FilePath.Local (breakExt) import Vervis.ChangeFeed (changeFeed) import Vervis.Form.Repo import Vervis.Foundation import Vervis.Path import Vervis.MediaType (chooseMediaType) 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 (buttonW) 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, readPatch) getGitRepoSource :: Repo -> ShrIdent -> RpIdent -> Text -> [Text] -> Handler Html getGitRepoSource repository user repo ref dir = do path <- askRepoDir user repo (branches, tags, msv) <- liftIO $ G.readSourceView path ref dir case msv of Nothing -> notFound Just sv -> do let parent = if null dir then [] else init dir dirs = zip parent (tail $ inits parent) defaultLayout $(widgetFile "repo/source-git") getGitRepoHeadChanges :: Repo -> ShrIdent -> RpIdent -> Handler TypedContent getGitRepoHeadChanges repository shar repo = getGitRepoChanges shar repo $ repoMainBranch repository getGitRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent getGitRepoChanges shar repo ref = do path <- askRepoDir shar repo (branches, tags) <- liftIO $ G.listRefs path if ref `S.member` branches || ref `S.member` tags then do (_, _, entries, navModel) <- getPageAndNavTop $ \ o l -> liftIO $ G.readChangesView path ref o l let refSelect = refSelectW shar repo branches tags changes = changesW shar repo entries pageNav = navWidget navModel feed = changeFeed shar repo (Just ref) VCSGit entries selectRep $ do provideRep $ defaultLayout $(widgetFile "repo/changes-git") 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 let number = zip ([1..] :: [Int]) defaultLayout $(widgetFile "repo/patch")