From 0d7349cb5d62508b31f036436b69d4b08492033e Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Fri, 13 May 2016 10:11:17 +0000 Subject: [PATCH] Split git and darcs specific handlers into separate submodules --- src/Vervis/Handler/Repo.hs | 64 +------------------- src/Vervis/Handler/Repo/Darcs.hs | 88 +++++++++++++++++++++++++++ src/Vervis/Handler/Repo/Git.hs | 100 +++++++++++++++++++++++++++++++ vervis.cabal | 2 + 4 files changed, 192 insertions(+), 62 deletions(-) create mode 100644 src/Vervis/Handler/Repo/Darcs.hs create mode 100644 src/Vervis/Handler/Repo/Git.hs diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 7631250..d321173 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -67,6 +67,8 @@ import Data.Git.Local import Text.FilePath.Local (breakExt) import Vervis.Form.Repo import Vervis.Foundation +import Vervis.Handler.Repo.Darcs +import Vervis.Handler.Repo.Git import Vervis.Path import Vervis.MediaType (chooseMediaType) import Vervis.Model @@ -146,34 +148,6 @@ getRepoR shar repo = do getGitRepoSource repository shar repo (repoMainBranch repository) [] -getDarcsRepoSource :: Repo -> Text -> Text -> [Text] -> Handler Html -getDarcsRepoSource repository user repo dir = do - path <- askRepoDir user repo - msv <- liftIO $ D.readSourceView path 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 $ do - setTitle $ toHtml $ intercalate " > " - ["Vervis", "People", user, "Repos", repo] - $(widgetFile "repo/source-darcs") - -getGitRepoSource :: Repo -> Text -> Text -> 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 $ do - setTitle $ toHtml $ intercalate " > " $ - ["Vervis", "People", user, "Repos", repo] - $(widgetFile "repo/source-git") - getRepoSourceR :: Text -> Text -> [Text] -> Handler Html getRepoSourceR shar repo refdir = do repository <- runDB $ selectRepo shar repo @@ -183,23 +157,6 @@ getRepoSourceR shar repo refdir = do [] -> notFound (ref:dir) -> getGitRepoSource repository shar repo ref dir -getDarcsRepoHeadChanges :: Text -> Text -> Handler Html -getDarcsRepoHeadChanges shar repo = do - path <- askRepoDir shar repo - (entries, navModel) <- getPageAndNav $ - \ o l -> do - mv <- liftIO $ D.readChangesView path o l - case mv of - Nothing -> notFound - Just v -> return v - let changes = changesW entries - pageNav = navWidget navModel - defaultLayout $(widgetFile "repo/changes-darcs") - -getGitRepoHeadChanges :: Repo -> Text -> Text -> Handler Html -getGitRepoHeadChanges repository shar repo = - getGitRepoChanges shar repo $ repoMainBranch repository - getRepoHeadChangesR :: Text -> Text -> Handler Html getRepoHeadChangesR user repo = do repository <- runDB $ selectRepo user repo @@ -207,23 +164,6 @@ getRepoHeadChangesR user repo = do VCSDarcs -> getDarcsRepoHeadChanges user repo VCSGit -> getGitRepoHeadChanges repository user repo -getDarcsRepoChanges :: Text -> Text -> Text -> Handler Html -getDarcsRepoChanges shar repo tag = notFound - -getGitRepoChanges :: Text -> Text -> Text -> Handler Html -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 entries - pageNav = navWidget navModel - defaultLayout $(widgetFile "repo/changes-git") - else notFound - getRepoChangesR :: Text -> Text -> Text -> Handler Html getRepoChangesR shar repo ref = do repository <- runDB $ selectRepo shar repo diff --git a/src/Vervis/Handler/Repo/Darcs.hs b/src/Vervis/Handler/Repo/Darcs.hs new file mode 100644 index 0000000..ea40d90 --- /dev/null +++ b/src/Vervis/Handler/Repo/Darcs.hs @@ -0,0 +1,88 @@ +{- 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.Handler.Repo.Darcs + ( getDarcsRepoSource + , getDarcsRepoHeadChanges + , getDarcsRepoChanges + ) +where + +import ClassyPrelude.Conduit hiding (last, unpack) +import Yesod hiding (Header, parseTime, (==.)) +import Yesod.Auth + +import Prelude (init, last, tail) + +import Data.List (inits) +import Data.Text (unpack) +import Data.Text.Encoding (decodeUtf8With) +import Data.Text.Encoding.Error (lenientDecode) +import Database.Esqueleto +import System.Directory (createDirectoryIfMissing) + +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 Text.FilePath.Local (breakExt) +import Vervis.Form.Repo +import Vervis.Foundation +import Vervis.Path +import Vervis.MediaType (chooseMediaType) +import Vervis.Model +import Vervis.Model.Repo +import Vervis.Paginate +import Vervis.Readme +import Vervis.Render +import Vervis.Settings +import Vervis.SourceTree +import Vervis.Style +import Vervis.Widget.Repo + +import qualified Darcs.Local.Repository as D (createRepo) +import qualified Data.ByteString.Lazy as BL (ByteString) +import qualified Vervis.Darcs as D (readSourceView, readChangesView) + +getDarcsRepoSource :: Repo -> Text -> Text -> [Text] -> Handler Html +getDarcsRepoSource repository user repo dir = do + path <- askRepoDir user repo + msv <- liftIO $ D.readSourceView path 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 $ do + setTitle $ toHtml $ intercalate " > " + ["Vervis", "People", user, "Repos", repo] + $(widgetFile "repo/source-darcs") + +getDarcsRepoHeadChanges :: Text -> Text -> Handler Html +getDarcsRepoHeadChanges shar repo = do + path <- askRepoDir shar repo + (entries, navModel) <- getPageAndNav $ + \ o l -> do + mv <- liftIO $ D.readChangesView path o l + case mv of + Nothing -> notFound + Just v -> return v + let changes = changesW entries + pageNav = navWidget navModel + defaultLayout $(widgetFile "repo/changes-darcs") + +getDarcsRepoChanges :: Text -> Text -> Text -> Handler Html +getDarcsRepoChanges shar repo tag = notFound diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Handler/Repo/Git.hs new file mode 100644 index 0000000..7c42e2f --- /dev/null +++ b/src/Vervis/Handler/Repo/Git.hs @@ -0,0 +1,100 @@ +{- 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.Handler.Repo.Git + ( getGitRepoSource + , getGitRepoHeadChanges + , getGitRepoChanges + ) +where + +import ClassyPrelude.Conduit hiding (last, unpack) +import Yesod hiding (Header, parseTime, (==.)) +import Yesod.Auth + +import Prelude (init, last, tail) + +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.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.Hourglass (dateCurrent) + +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.Form.Repo +import Vervis.Foundation +import Vervis.Path +import Vervis.MediaType (chooseMediaType) +import Vervis.Model +import Vervis.Model.Repo +import Vervis.Paginate +import Vervis.Readme +import Vervis.Render +import Vervis.Settings +import Vervis.SourceTree +import Vervis.Style +import Vervis.Widget.Repo + +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) + +getGitRepoSource :: Repo -> Text -> Text -> 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 -> Text -> Text -> Handler Html +getGitRepoHeadChanges repository shar repo = + getGitRepoChanges shar repo $ repoMainBranch repository + +getGitRepoChanges :: Text -> Text -> Text -> Handler Html +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 entries + pageNav = navWidget navModel + defaultLayout $(widgetFile "repo/changes-git") + else notFound diff --git a/vervis.cabal b/vervis.cabal index a13870b..59aa614 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -82,6 +82,8 @@ library Vervis.Handler.Person Vervis.Handler.Project Vervis.Handler.Repo + Vervis.Handler.Repo.Darcs + Vervis.Handler.Repo.Git Vervis.Handler.Ticket Vervis.Handler.Util Vervis.Import