Experimental changes to Vervis.
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/KrXYo
SSH:
darcs clone USERNAME@vervis.peers.community:KrXYo
Tags
TODO
Git.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | {- This file is part of Vervis.
-
- Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ 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
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
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 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.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) <- getPageAndNav $
\ 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")
|