diff --git a/config/models b/config/models index 762a730..76c5769 100644 --- a/config/models +++ b/config/models @@ -45,11 +45,12 @@ Project UniqueProject ident sharer Repo - ident Text --CI - project ProjectId - desc Text Maybe - irc IrcChannelId Maybe - ml Text Maybe + ident Text --CI + project ProjectId + desc Text Maybe + irc IrcChannelId Maybe + ml Text Maybe + mainBranch Text default='master' UniqueRepo ident project diff --git a/src/Data/ByteString/Char8/Local.hs b/src/Data/ByteString/Char8/Local.hs new file mode 100644 index 0000000..5fcd853 --- /dev/null +++ b/src/Data/ByteString/Char8/Local.hs @@ -0,0 +1,28 @@ +{- 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 Data.ByteString.Char8.Local + ( takeLine + ) +where + +import Prelude hiding (takeWhile) + +import Data.ByteString.Char8 + +import Data.Char.Local (isNewline) + +takeLine :: ByteString -> ByteString +takeLine = takeWhile $ not . isNewline diff --git a/src/Data/Char/Local.hs b/src/Data/Char/Local.hs index 1092337..9dc1f40 100644 --- a/src/Data/Char/Local.hs +++ b/src/Data/Char/Local.hs @@ -15,6 +15,7 @@ module Data.Char.Local ( isAsciiLetter + , isNewline ) where @@ -22,3 +23,6 @@ import Prelude isAsciiLetter :: Char -> Bool isAsciiLetter c = 'A' <= c && c <= 'Z' || 'a' <= c && c <= 'z' + +isNewline :: Char -> Bool +isNewline c = c == '\n' || c == '\r' diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs index 9e64a5b..44f89d3 100644 --- a/src/Data/Git/Local.hs +++ b/src/Data/Git/Local.hs @@ -154,7 +154,7 @@ loadCommitGraphByName :: Graph g => Git -> String -> IO (CommitGraph g) loadCommitGraphByName git name = do mg <- loadCommitGraphByNameMaybe git name case mg of - Nothing -> error "" + Nothing -> error "no such ref" Just g -> return g -- | Load a commit graph and topsort the commits. The resulting list starts diff --git a/src/Vervis/Form/Repo.hs b/src/Vervis/Form/Repo.hs index a08e410..b19af4c 100644 --- a/src/Vervis/Form/Repo.hs +++ b/src/Vervis/Form/Repo.hs @@ -28,6 +28,7 @@ newRepoAForm sid pid = Repo <*> aopt textField "Description" Nothing <*> pure Nothing <*> pure Nothing + <*> pure "master" newRepoForm :: SharerId -> ProjectId -> Form Repo newRepoForm sid pid = renderDivs $ newRepoAForm sid pid diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index 2770d7a..1e76a26 100644 --- a/src/Vervis/Git.hs +++ b/src/Vervis/Git.hs @@ -20,6 +20,7 @@ module Vervis.Git ( lastChange , timeAgo + , timeAgo' ) where @@ -114,20 +115,10 @@ fromSec sec = timeAgo :: DateTime -> IO Text timeAgo dt = do now <- dateCurrent + return $ timeAgo' now dt + +timeAgo' :: DateTime -> DateTime -> Text +timeAgo' now dt = let sec = timeDiff now dt (period, duration) = fromSec sec - return $ showAgo period duration - -{-commits' :: Git -> Ref -> Int -> IO [(Text, Text, Text, Text)] -commits' git r l = go r l - where - go _ 0 = return [] - go ref lim = do - commit <- getCommit git ref - -commits :: Git -> String -> Int -> IO [(Text, Text, Text, Text)] -commits git branch lim = do - mref <- resolveRevision git $ Revision branch [] - case mref of - Nothing -> return [] - Just ref -> commits' git ref lim-} + in showAgo period duration diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 838aaa8..11bb01d 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -28,14 +28,32 @@ where -- [x] add new repo creation link -- [x] make new repo form -- [x] write the git and mkdir parts that actually create the repo --- [ ] make repo view that shows a table of commits +-- [x] make repo view that shows a table of commits +import ClassyPrelude.Conduit hiding (unpack) +import Yesod hiding (Header, parseTime, (==.)) +import Yesod.Auth + +import Data.Git.Ref (toHex) import Data.Git.Repository (initRepo) +import Data.Git.Storage (withRepo) +import Data.Git.Types (Commit (..), Person (..)) +import Data.Text (unpack) +import Data.Text.Encoding (decodeUtf8With) +import Data.Text.Encoding.Error (lenientDecode) import Database.Esqueleto +import Data.Hourglass (timeConvert) import System.Directory (createDirectoryIfMissing) ---import System.FilePath (()) -import Vervis.Import hiding ((==.)) +import System.Hourglass (dateCurrent) + +import Data.ByteString.Char8.Local (takeLine) +import Data.Git.Local (loadCommitsTopsortList) import Vervis.Form.Repo +import Vervis.Foundation +import Vervis.Git (timeAgo') +import Vervis.Path +import Vervis.Model +import Vervis.Settings getReposR :: Text -> Text -> Handler Html getReposR user proj = do @@ -59,9 +77,8 @@ postReposR user proj = do ((result, widget), enctype) <- runFormPost $ newRepoForm sid pid case result of FormSuccess repo -> do - root <- appRepoDir . appSettings <$> getYesod - let parent = root unpack user unpack proj - path = parent unpack (repoIdent repo) + parent <- askProjectDir user proj + let path = parent unpack (repoIdent repo) liftIO $ createDirectoryIfMissing True parent liftIO $ initRepo $ fromString path runDB $ insert_ repo @@ -92,6 +109,18 @@ getRepoR user proj repo = do Entity pid _p <- getBy404 $ UniqueProject proj sid Entity _rid r <- getBy404 $ UniqueRepo repo pid return r + path <- askRepoDir user proj repo + pairs <- liftIO $ withRepo (fromString path) $ \ git -> + loadCommitsTopsortList git $ unpack $ repoMainBranch repository + now <- liftIO dateCurrent + let toText = decodeUtf8With lenientDecode + mkrow ref commit = + ( toText $ personName $ commitAuthor commit + , toText $ toHex ref + , toText $ takeLine $ commitMessage commit + , timeAgo' now (timeConvert $ personTime $ commitAuthor commit) + ) + rows = map (uncurry mkrow) pairs defaultLayout $ do setTitle $ toHtml $ intercalate " > " $ ["Vervis", "People", user, "Projects", proj, "Repos", repo] diff --git a/templates/repo.hamlet b/templates/repo.hamlet index 5244941..73930fc 100644 --- a/templates/repo.hamlet +++ b/templates/repo.hamlet @@ -28,3 +28,17 @@ $# . #{desc} $nothing (none) + +

History + + + +
Author + Hash + Message + Time + $forall (author, hash, message, time) <- rows +
#{author} + #{hash} + #{message} + #{time} diff --git a/vervis.cabal b/vervis.cabal index 8edebe3..a27e420 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -34,7 +34,8 @@ flag library-only default: False library - exposed-modules: Data.Char.Local + exposed-modules: Data.ByteString.Char8.Local + Data.Char.Local Data.Git.Local Data.Graph.Inductive.Local Data.List.Local