mirror of
https://code.sup39.dev/repos/Wqawg
synced 2025-01-10 01:56:47 +09:00
129 lines
4.5 KiB
Haskell
129 lines
4.5 KiB
Haskell
{- 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.Form.Repo
|
|
( NewRepo (..)
|
|
, newRepoForm
|
|
, NewRepoCollab (..)
|
|
, newRepoCollabForm
|
|
, editRepoForm
|
|
)
|
|
where
|
|
|
|
--import Prelude
|
|
|
|
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
|
|
import Vervis.Model.Repo
|
|
|
|
data NewRepo = NewRepo
|
|
{ nrpIdent :: RpIdent
|
|
, nrpVcs :: VersionControlSystem
|
|
, nrpProj :: Maybe ProjectId
|
|
, nrpDesc :: Maybe Text
|
|
, nrpRole :: RepoRoleId
|
|
}
|
|
|
|
newRepoAForm
|
|
:: PersonId -> SharerId -> Maybe ProjectId -> AForm Handler NewRepo
|
|
newRepoAForm pid sid mpid = NewRepo
|
|
<$> (text2rp <$> areq (mkIdentField sid) "Identifier*" Nothing)
|
|
<*> areq (selectFieldList vcsList) "Version control system*" Nothing
|
|
<*> aopt (selectProjectForNew sid) "Project" (Just mpid)
|
|
<*> aopt textField "Description" Nothing
|
|
<*> areq selectRole "Your role*" Nothing
|
|
where
|
|
vcsList :: [(Text, VersionControlSystem)]
|
|
vcsList =
|
|
[ ("Darcs", VCSDarcs)
|
|
, ("Git" , VCSGit)
|
|
]
|
|
selectRole =
|
|
selectField $
|
|
optionsPersistKey [RepoRolePerson ==. pid] [] $
|
|
rl2text . repoRoleIdent
|
|
|
|
newRepoForm :: PersonId -> SharerId -> Maybe ProjectId -> Form NewRepo
|
|
newRepoForm pid sid mpid = renderDivs $ newRepoAForm pid sid mpid
|
|
|
|
data NewRepoCollab = NewRepoCollab
|
|
{ ncPerson :: PersonId
|
|
, ncRole :: RepoRoleId
|
|
}
|
|
|
|
newRepoCollabAForm
|
|
:: PersonId -> Maybe ProjectId -> RepoId -> AForm Handler NewRepoCollab
|
|
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
|
|
selectRole =
|
|
selectField $
|
|
optionsPersistKey [RepoRolePerson ==. pid] [] $
|
|
rl2text . repoRoleIdent
|
|
|
|
newRepoCollabForm
|
|
:: PersonId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab
|
|
newRepoCollabForm pid mjid rid = renderDivs $ newRepoCollabAForm pid mjid rid
|
|
|
|
editRepoAForm :: Entity Repo -> AForm Handler Repo
|
|
editRepoAForm (Entity rid repo) = Repo
|
|
<$> pure (repoIdent repo)
|
|
<*> pure (repoSharer repo)
|
|
<*> pure (repoVcs repo)
|
|
<*> aopt selectProject' "Project" (Just $ repoProject repo)
|
|
<*> aopt textField "Description" (Just $ repoDesc repo)
|
|
<*> let b = repoMainBranch repo
|
|
in case repoVcs repo of
|
|
VCSDarcs -> pure b
|
|
VCSGit -> areq textField "Main branch*" (Just b)
|
|
where
|
|
selectProject' = selectProjectForExisting (repoSharer repo) rid
|
|
|
|
editRepoForm :: Entity Repo -> Form Repo
|
|
editRepoForm r = renderDivs $ editRepoAForm r
|