diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index 7ff6081..ff910ce 100644 --- a/src/Vervis/Git.hs +++ b/src/Vervis/Git.hs @@ -15,6 +15,7 @@ module Vervis.Git ( readSourceView + , readChangesView ) where @@ -22,18 +23,32 @@ import Prelude import Data.Foldable (find) import Data.Git +import Data.Git.Graph import Data.Git.Harder +import Data.Git.Ref (toHex) import Data.Git.Storage (getObject_) import Data.Git.Storage.Object (Object (..)) +import Data.Git.Types (GitTime (..)) +import Data.Graph.Inductive.Graph (noNodes) +import Data.Graph.Inductive.Query.Topsort import Data.Set (Set) import Data.String (fromString) -import Data.Text (Text, unpack, pack) +import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) +import System.Hourglass (timeCurrent) +import Time.Types (Elapsed (..)) 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.Encoding as TE (decodeUtf8With) +import qualified Data.Text.Encoding.Error as TE (lenientDecode) +import Data.ByteString.Char8.Local (takeLine) +import Data.EventTime.Local import Data.Git.Local +import Vervis.Changes import Vervis.Foundation (Widget) import Vervis.Readme import Vervis.SourceTree @@ -69,7 +84,7 @@ loadSourceView loadSourceView git refT dir = do branches <- branchList git tags <- tagList git - let refS = unpack refT + let refS = T.unpack refT refN = RefName refS msv <- if refN `S.member` branches || refN `S.member` tags then do @@ -108,5 +123,46 @@ readSourceView readSourceView path ref dir = do (bs, ts, msv) <- withRepo (fromString path) $ \ git -> loadSourceView git ref dir - let toTexts = S.mapMonotonic $ pack . refNameRaw + let toTexts = S.mapMonotonic $ T.pack . refNameRaw return (toTexts bs, toTexts ts, renderSources dir <$> msv) + +instance ResultList D.DList where + emptyList = D.empty + appendItem = flip D.snoc + +readChangesView + :: FilePath + -- ^ Repository path + -> Text + -- ^ Name of branch or tag + -> IO (Set Text, Set Text, Maybe [LogEntry]) + -- ^ Branches, tags, view of selected ref's change log +readChangesView path ref = withRepo (fromString path) $ \ git -> do + let toTexts = S.mapMonotonic $ T.pack . refNameRaw + branches <- toTexts <$> branchList git + tags <- toTexts <$> tagList git + ml <- if ref `S.member` branches || ref `S.member` tags + then do + oid <- resolveName git $ T.unpack ref + graph <- loadCommitGraphPT git [oid] + let mnodes = topsortUnmixOrder graph (NodeStack [noNodes graph]) + nodes = case mnodes of + Nothing -> error "commit graph contains a cycle" + Just ns -> ns + pairs = D.toList $ fmap (nodeLabel graph) nodes + toText = TE.decodeUtf8With TE.lenientDecode + Elapsed now <- timeCurrent + let mkrow oid commit = LogEntry + { leAuthor = toText $ personName $ commitAuthor commit + , leHash = toText $ toHex $ unObjId oid + , leMessage = toText $ takeLine $ commitMessage commit + , leTime = + intervalToEventTime $ + FriendlyConvert $ + now - t + } + where + Elapsed t = gitTimeUTC $ personTime $ commitAuthor commit + return $ Just $ map (uncurry mkrow) pairs + else return Nothing + return (branches, tags, ml) diff --git a/src/Vervis/Handler/Home.hs b/src/Vervis/Handler/Home.hs index 6b98f2c..a5175e8 100644 --- a/src/Vervis/Handler/Home.hs +++ b/src/Vervis/Handler/Home.hs @@ -25,6 +25,7 @@ import Vervis.GitOld import qualified Database.Esqueleto as E ((==.)) +import Vervis.Model.Repo import Vervis.Path intro :: Handler Html @@ -43,16 +44,21 @@ intro = do ( sharer ^. SharerIdent , project ?. ProjectIdent , repo ^. RepoIdent + , repo ^. RepoVcs ) root <- askRepoRootDir - liftIO $ forM repos $ \ (Value sharer, Value mproj, Value repo) -> do - let path = - root unpack sharer unpack repo - mdt <- lastChange path - ago <- case mdt of - Nothing -> return "never" - Just dt -> timeAgo dt - return (sharer, mproj, repo, ago) + liftIO $ forM repos $ + \ (Value sharer, Value mproj, Value repo, Value vcs) -> do + ago <- case vcs of + VCSDarcs -> return "[Not implemented yet]" + VCSGit -> do + let path = + root unpack sharer unpack repo + mdt <- lastChange path + case mdt of + Nothing -> return "never" + Just dt -> timeAgo dt + return (sharer, mproj, repo, vcs, ago) defaultLayout $ do setTitle "Welcome to Vervis!" $(widgetFile "homepage") diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 6ffe89d..930be70 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -77,12 +77,13 @@ import Vervis.Render import Vervis.Settings import Vervis.SourceTree import Vervis.Style +import Vervis.Widget.Repo import qualified Darcs.Local as D (createRepo) import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Data.Git.Local as G (createRepo) import qualified Vervis.Darcs as D (readSourceView) -import qualified Vervis.Git as G (readSourceView) +import qualified Vervis.Git as G (readSourceView, readChangesView) getReposR :: Text -> Handler Html getReposR user = do @@ -130,10 +131,6 @@ getRepoNewR user = do setTitle $ toHtml $ mconcat ["Vervis > People > ", user, " > New Repo"] $(widgetFile "repo/repo-new") -instance ResultList D.DList where - emptyList = D.empty - appendItem = flip D.snoc - selectRepo :: Text -> Text -> AppDB Repo selectRepo shar repo = do Entity sid _s <- getBy404 $ UniqueSharerIdent shar @@ -206,27 +203,13 @@ getDarcsRepoChanges shar repo tag = notFound getGitRepoChanges :: Text -> Text -> Text -> Handler Html getGitRepoChanges shar repo ref = do path <- askRepoDir shar repo - pairs <- liftIO $ withRepo (fromString path) $ \ git -> do - oid <- resolveName git $ unpack ref - graph <- loadCommitGraphPT git [oid] - let mnodes = topsortUnmixOrder graph (NodeStack [noNodes graph]) - nodes = case mnodes of - Nothing -> error "commit graph contains a cycle" - Just ns -> ns - return $ D.toList $ fmap (nodeLabel graph) nodes - now <- liftIO dateCurrent - let toText = decodeUtf8With lenientDecode - mkrow oid commit = - ( toText $ personName $ commitAuthor commit - , toText $ toHex $ unObjId oid - , toText $ takeLine $ commitMessage commit - , timeAgo' now (timeConvert $ personTime $ commitAuthor commit) - ) - rows = map (uncurry mkrow) pairs - defaultLayout $ do - setTitle $ toHtml $ intercalate " > " - ["Vervis", "People", shar, "Repos", repo, "Commits"] - $(widgetFile "repo/changes-git") + (branches, tags, mentries) <- liftIO $ G.readChangesView path ref + case mentries of + Nothing -> notFound + Just entries -> + let refSelect = refSelectW shar repo branches tags + changes = changesW entries + in defaultLayout $(widgetFile "repo/changes-git") getRepoChangesR :: Text -> Text -> Text -> Handler Html getRepoChangesR shar repo ref = do diff --git a/src/Vervis/Widget/Repo.hs b/src/Vervis/Widget/Repo.hs new file mode 100644 index 0000000..460ca25 --- /dev/null +++ b/src/Vervis/Widget/Repo.hs @@ -0,0 +1,37 @@ +{- This file is part of Vervis. + - + - Written in 2016 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.Widget.Repo + ( refSelectW + , changesW + ) +where + +import Prelude + +import Data.Set (Set) +import Data.Text (Text) + +import qualified Data.Text as T (take) + +import Vervis.Changes +import Vervis.Foundation +import Vervis.Settings (widgetFile) + +refSelectW :: Text -> Text -> Set Text -> Set Text -> Widget +refSelectW shar repo branches tags = $(widgetFile "repo/widget/ref-select") + +changesW :: Foldable f => f LogEntry -> Widget +changesW entries = $(widgetFile "repo/widget/changes") diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index 08908ee..8a1600f 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -21,7 +21,7 @@ $nothing You are not logged in. Log in. -^{breadcrumbBar} +^{breadcrumbsW} $maybe msg <- mmsg
#{msg} diff --git a/templates/homepage.hamlet b/templates/homepage.hamlet index f7b15b1..696c42b 100644 --- a/templates/homepage.hamlet +++ b/templates/homepage.hamlet @@ -27,8 +27,9 @@ $# . Sharer Project Repo + VCS Last change - $forall (sharer, mproj, repo, ago) <- rows + $forall (sharer, mproj, repo, vcs, ago) <- rows #{sharer} @@ -39,6 +40,12 @@ $# . (none) #{repo} + + $case vcs + $of VCSDarcs + Darcs + $of VCSGit + Git #{ago}

People diff --git a/templates/repo/changes-git.hamlet b/templates/repo/changes-git.hamlet index 089c256..e0faba2 100644 --- a/templates/repo/changes-git.hamlet +++ b/templates/repo/changes-git.hamlet @@ -12,15 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . - - - -
Author - Hash - Message - Time - $forall (author, hash, message, time) <- rows -
#{author} - #{hash} - #{message} - #{time} +^{refSelect} + +^{changes} diff --git a/templates/repo/widget/changes.cassius b/templates/repo/widget/changes.cassius new file mode 100644 index 0000000..65bfa66 --- /dev/null +++ b/templates/repo/widget/changes.cassius @@ -0,0 +1,17 @@ +/* This file is part of Vervis. + * + * Written in 2016 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 + * . + */ + +.hash + font-family: monospace diff --git a/templates/repo/widget/changes.hamlet b/templates/repo/widget/changes.hamlet new file mode 100644 index 0000000..8a03b69 --- /dev/null +++ b/templates/repo/widget/changes.hamlet @@ -0,0 +1,26 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 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 +$# . + + + + +
Author + Hash + Message + Time + $forall LogEntry author hash message time <- entries +
#{author} + #{T.take 10 hash} + #{message} + #{time} diff --git a/templates/repo/widget/ref-select.hamlet b/templates/repo/widget/ref-select.hamlet new file mode 100644 index 0000000..05b6c78 --- /dev/null +++ b/templates/repo/widget/ref-select.hamlet @@ -0,0 +1,27 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 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 +$# . + +

Branches + +