Write missing repo collaborator handlers

src/Vervis/Form/Repo.hs

@@ -16,12 +16,18 @@
 module Vervis.Form.Repo
     ( NewRepo (..)
     , newRepoForm
+    , NewCollab (..)
+    , newCollabForm
     )
 where
 
 --import Prelude
 
-import Vervis.Import
+import Database.Esqueleto hiding ((==.))
+
+import qualified Database.Esqueleto as E ((==.))
+
+import Vervis.Import hiding (isNothing, on)
 import Vervis.Field.Repo
 import Vervis.Model
 import Vervis.Model.Ident
@@ -60,3 +66,31 @@ newRepoAForm pid sid mpid = NewRepo
 
 newRepoForm :: PersonId -> SharerId -> Maybe ProjectId -> Form NewRepo
 newRepoForm pid sid mpid = renderDivs $ newRepoAForm pid sid mpid
+
+data NewCollab = NewCollab
+    { ncPerson :: PersonId
+    , ncRole   :: RoleId
+    }
+
+newCollabAForm :: PersonId -> RepoId -> AForm Handler NewCollab
+newCollabAForm pid rid = NewCollab
+    <$> areq selectPerson "Person*" Nothing
+    <*> areq selectRole   "Role*"   Nothing
+    where
+    selectPerson = selectField $ do
+        l <- runDB $ select $
+            from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
+                on $ person ^. PersonIdent  E.==. sharer ^. SharerId
+                on $
+                    collab ?. CollabRepo   E.==. just (val rid)            &&.
+                    collab ?. CollabPerson E.==. just (person ^. PersonId)
+                where_ $ isNothing $ collab ?. CollabId
+                return (sharer ^. SharerIdent, person ^. PersonId)
+        optionsPairs $ map (shr2text . unValue *** unValue) l
+    selectRole =
+        selectField $
+        optionsPersistKey [RolePerson ==. pid] [] $
+        rl2text . roleIdent
+
+newCollabForm :: PersonId -> RepoId -> Form NewCollab
+newCollabForm pid rid = renderDivs $ newCollabAForm pid rid

src/Vervis/Handler/Repo.hs

@@ -89,6 +89,7 @@ import Vervis.Settings
 import Vervis.SourceTree
 import Vervis.Style
 import Vervis.Widget.Repo
+import Vervis.Widget.Sharer
 
 import qualified Darcs.Local.Repository as D (createRepo)
 import qualified Data.ByteString.Lazy as BL (ByteString)
@@ -219,16 +220,72 @@ getRepoChangesR shar repo ref = do
         VCSGit -> getGitRepoChanges shar repo ref
 
 getRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
-getRepoDevsR shr rp = error "Not implemented"
+getRepoDevsR shr rp = do
+    devs <- runDB $ do
+        rid <- do
+            Entity s _ <- getBy404 $ UniqueSharer shr
+            Entity r _ <- getBy404 $ UniqueRepo rp s
+            return r
+        select $ from $ \ (collab, person, sharer, role) -> do
+            where_ $
+                collab ^. CollabRepo   ==. val rid            &&.
+                collab ^. CollabPerson ==. person ^. PersonId &&.
+                person ^. PersonIdent  ==. sharer ^. SharerId &&.
+                collab ^. CollabRole   ==. role ^. RoleId
+            return (sharer, role ^. RoleIdent)
+    defaultLayout $(widgetFile "repo/collab/list")
 
 postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
-postRepoDevsR shr rp = error "Not implemented"
+postRepoDevsR shr rp = do
+    (pid, rid) <- runDB $ do
+        Entity s _ <- getBy404 $ UniqueSharer shr
+        Entity p _ <- getBy404 $ UniquePersonIdent s
+        Entity r _ <- getBy404 $ UniqueRepo rp s
+        return (p, r)
+    ((result, widget), enctype) <- runFormPost $ newCollabForm pid rid
+    case result of
+        FormSuccess nc -> do
+            runDB $ do
+                let collab = Collab
+                        { collabRepo   = rid
+                        , collabPerson = ncPerson nc
+                        , collabRole   = ncRole nc
+                        }
+                insert_ collab
+            setMessage "Collaborator added."
+            redirect $ RepoDevsR shr rp
+        FormMissing -> do
+            setMessage "Field(s) missing"
+            defaultLayout $(widgetFile "repo/collab/new")
+        FormFailure _l -> do
+            setMessage "Operation failed, see errors below"
+            defaultLayout $(widgetFile "repo/collab/new")
 
 getRepoDevNewR :: ShrIdent -> RpIdent -> Handler Html
-getRepoDevNewR shr rp = error "Not implemented"
+getRepoDevNewR shr rp = do
+    (pid, rid) <- runDB $ do
+        Entity s _ <- getBy404 $ UniqueSharer shr
+        Entity p _ <- getBy404 $ UniquePersonIdent s
+        Entity r _ <- getBy404 $ UniqueRepo rp s
+        return (p, r)
+    ((_result, widget), enctype) <- runFormPost $ newCollabForm pid rid
+    defaultLayout $(widgetFile "repo/collab/new")
 
 getRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
-getRepoDevR shr rp dev = error "Not implemented"
+getRepoDevR shr rp dev = do
+    rl <- runDB $ do
+        rid <- do
+            Entity s _ <- getBy404 $ UniqueSharer shr
+            Entity r _ <- getBy404 $ UniqueRepo rp s
+            return r
+        pid <- do
+            Entity s _ <- getBy404 $ UniqueSharer dev
+            Entity p _ <- getBy404 $ UniquePersonIdent s
+            return p
+        Entity _cid collab <- getBy404 $ UniqueCollab rid pid
+        role <- getJust $ collabRole collab
+        return $ roleIdent role
+    defaultLayout $(widgetFile "repo/collab/one")
 
 deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
 deleteRepoDevR shr rp dev = do

templates/repo/collab/list.hamlet

@@ -0,0 +1,22 @@
+$# 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/>.
+
+<table>
+  <tr>
+    <th>Collaborator
+    <th>Role
+  $forall (Entity _sid sharer, Value rl) <- devs
+    <tr>
+      <td>^{personLinkW sharer}
+      <td>#{rl2text rl}

templates/repo/collab/new.hamlet

@@ -0,0 +1,17 @@
+$# 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/>.
+
+<form method=POST action=@{RepoDevsR shr rp} enctype=#{enctype}>
+  ^{widget}
+  <input type=submit>

templates/repo/collab/one.hamlet

@@ -0,0 +1,16 @@
+$# 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/>.
+
+<p>
+  Role: #{rl2text rl}