Split git and darcs specific handlers into separate submodules

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

src/Vervis/Handler/Repo/Darcs.hs

@@ -0,0 +1,88 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 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.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

src/Vervis/Handler/Repo/Git.hs

@@ -0,0 +1,100 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 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
+    )
+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

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