From c86c0f547ad82127de5d1c7dfa998fccf472320d Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Mon, 6 Jun 2016 06:03:42 +0000
Subject: [PATCH] Move repo collab selector fields to the field module

---
 src/Vervis/Field/Repo.hs | 40 +++++++++++++++++++++++++++++++++++++++-
 src/Vervis/Form/Repo.hs  | 29 ++---------------------------
 2 files changed, 41 insertions(+), 28 deletions(-)

diff --git a/src/Vervis/Field/Repo.hs b/src/Vervis/Field/Repo.hs
index 2eb562b..e75e612 100644
--- a/src/Vervis/Field/Repo.hs
+++ b/src/Vervis/Field/Repo.hs
@@ -15,6 +15,8 @@
 
 module Vervis.Field.Repo
     ( mkIdentField
+    , selectCollabFromAll
+    , selectCollabFromProject
     , selectProjectForNew
     , selectProjectForExisting
     )
@@ -29,7 +31,7 @@ import Database.Esqueleto
 
 import qualified Database.Persist as P ((==.))
 
-import Vervis.Model.Ident (text2rp, prj2text)
+import Vervis.Model.Ident (shr2text, text2rp, prj2text)
 
 checkIdentTemplate :: Field Handler Text -> Field Handler Text
 checkIdentTemplate =
@@ -59,6 +61,42 @@ checkIdentUnique sid = checkM $ \ ident -> do
 mkIdentField :: SharerId -> Field Handler Text
 mkIdentField sid = checkIdentUnique sid . checkIdentTemplate $ textField
 
+-- | Select a new collaborator for a repo, from the list of users of the
+-- server. It can be any person who isn't already a collaborator.
+selectCollabFromAll :: RepoId -> Field Handler PersonId
+selectCollabFromAll rid = selectField $ do
+    l <- runDB $ select $
+        from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
+            on $ person ^. PersonIdent  ==. sharer ^. SharerId
+            on $
+                collab ?. RepoCollabRepo   ==. just (val rid) &&.
+                collab ?. RepoCollabPerson ==. just (person ^. PersonId)
+            where_ $ isNothing $ collab ?. RepoCollabId
+            return (sharer ^. SharerIdent, person ^. PersonId)
+    optionsPairs $ map (shr2text . unValue *** unValue) l
+
+-- | Select a new collaborator for a repo, from the list of collaborators of
+-- the project it belongs to. It can be any collaborator of the project, who
+-- isn't yet a collaborator of the repo.
+selectCollabFromProject :: ProjectId -> RepoId -> Field Handler PersonId
+selectCollabFromProject jid rid = selectField $ do
+    l <- runDB $ select $ from $
+        \ ( pcollab `InnerJoin`
+            person  `LeftOuterJoin`
+            rcollab `InnerJoin`
+            sharer
+            ) -> do
+            on $ person ^. PersonIdent ==. sharer ^. SharerId
+            on $
+                rcollab ?. RepoCollabRepo   ==. just (val rid) &&.
+                rcollab ?. RepoCollabPerson ==. just (person ^. PersonId)
+            on $
+                pcollab ^. ProjectCollabProject ==. val jid &&.
+                pcollab ^. ProjectCollabPerson  ==. person ^. PersonId
+            where_ $ isNothing $ rcollab ?. RepoCollabId
+            return (sharer ^. SharerIdent, person ^. PersonId)
+    optionsPairs $ map (shr2text . unValue *** unValue) l
+
 -- | Select a project for a new repository to belong to. It can be any project
 -- of the same sharer who's sharing the repo.
 selectProjectForNew :: SharerId -> Field Handler ProjectId
diff --git a/src/Vervis/Form/Repo.hs b/src/Vervis/Form/Repo.hs
index 8e213f4..df15d55 100644
--- a/src/Vervis/Form/Repo.hs
+++ b/src/Vervis/Form/Repo.hs
@@ -75,33 +75,8 @@ newRepoCollabAForm pid mjid rid = NewRepoCollab
     <$> areq (selectPerson mjid) "Person*" Nothing
     <*> areq selectRole          "Role*"   Nothing
     where
-    selectPerson Nothing = selectField $ do
-        l <- runDB $ select $
-            from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
-                on $ person ^. PersonIdent  E.==. sharer ^. SharerId
-                on $
-                    collab ?. RepoCollabRepo   E.==. just (val rid) &&.
-                    collab ?. RepoCollabPerson E.==. just (person ^. PersonId)
-                where_ $ isNothing $ collab ?. RepoCollabId
-                return (sharer ^. SharerIdent, person ^. PersonId)
-        optionsPairs $ map (shr2text . unValue *** unValue) l
-    selectPerson (Just jid) = selectField $ do
-        l <- runDB $ select $ from $
-            \ ( pcollab `InnerJoin`
-                person  `LeftOuterJoin`
-                rcollab `InnerJoin`
-                sharer
-              ) -> do
-                on $ person ^. PersonIdent  E.==. sharer ^. SharerId
-                on $
-                    rcollab ?. RepoCollabRepo   E.==. just (val rid) &&.
-                    rcollab ?. RepoCollabPerson E.==. just (person ^. PersonId)
-                on $
-                    pcollab ^. ProjectCollabProject E.==. val jid &&.
-                    pcollab ^. ProjectCollabPerson  E.==. person ^. PersonId
-                where_ $ isNothing $ rcollab ?. RepoCollabId
-                return (sharer ^. SharerIdent, person ^. PersonId)
-        optionsPairs $ map (shr2text . unValue *** unValue) l
+    selectPerson Nothing    = selectCollabFromAll rid
+    selectPerson (Just jid) = selectCollabFromProject jid rid
     selectRole =
         selectField $
         optionsPersistKey [RepoRolePerson ==. pid] [] $