sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-31 07:54:51 +09:00
Code Issues Activity

Move repo collab selector fields to the field module

Browse source
This commit is contained in:
fr33domlover 2016-06-06 06:03:42 +00:00
parent 52b9717a3a
commit c86c0f547a
2 changed files with 41 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
src/Vervis/Field/Repo.hs
View file

@ -15,6 +15,8 @@
module Vervis.Field.Repo module Vervis.Field.Repo
( mkIdentField ( mkIdentField
, selectCollabFromAll
, selectCollabFromProject
, selectProjectForNew , selectProjectForNew
, selectProjectForExisting , selectProjectForExisting
) )
@ -29,7 +31,7 @@ import Database.Esqueleto
import qualified Database.Persist as P ((==.)) 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 :: Field Handler Text -> Field Handler Text
checkIdentTemplate = checkIdentTemplate =
@ -59,6 +61,42 @@ checkIdentUnique sid = checkM $ \ ident -> do
mkIdentField :: SharerId -> Field Handler Text mkIdentField :: SharerId -> Field Handler Text
mkIdentField sid = checkIdentUnique sid . checkIdentTemplate $ textField 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 -- | Select a project for a new repository to belong to. It can be any project
-- of the same sharer who's sharing the repo. -- of the same sharer who's sharing the repo.
selectProjectForNew :: SharerId -> Field Handler ProjectId selectProjectForNew :: SharerId -> Field Handler ProjectId

29
src/Vervis/Form/Repo.hs
View file

@ -75,33 +75,8 @@ newRepoCollabAForm pid mjid rid = NewRepoCollab
<$> areq (selectPerson mjid) "Person*" Nothing <$> areq (selectPerson mjid) "Person*" Nothing
<*> areq selectRole "Role*" Nothing <*> areq selectRole "Role*" Nothing
where where
selectPerson Nothing = selectField $ do selectPerson Nothing = selectCollabFromAll rid
l <- runDB $ select $ selectPerson (Just jid) = selectCollabFromProject jid rid
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
selectRole = selectRole =
selectField $ selectField $
optionsPersistKey [RepoRolePerson ==. pid] [] $ optionsPersistKey [RepoRolePerson ==. pid] [] $