When creating a project, must choose a role for self
This commit is contained in:
fr33domlover
parent
c86c0f547a
commit
ef42bf29cd
4 changed files with 63 additions and 37 deletions
|
|
@ -14,7 +14,7 @@
|
|||
-}
|
||||
|
||||
module Vervis.Field.Project
|
||||
( mkIdentField
|
||||
( newProjectIdentField
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -25,10 +25,10 @@ import Data.Char.Local (isAsciiLetter)
|
|||
import Data.Text (split)
|
||||
import Database.Esqueleto
|
||||
|
||||
import Vervis.Model.Ident (text2prj)
|
||||
import Vervis.Model.Ident (PrjIdent, prj2text, text2prj)
|
||||
|
||||
checkIdentTemplate :: Field Handler Text -> Field Handler Text
|
||||
checkIdentTemplate =
|
||||
checkTemplate :: Field Handler Text -> Field Handler Text
|
||||
checkTemplate =
|
||||
let charOk c = isAsciiLetter c || isDigit c
|
||||
wordOk w = (not . null) w && all charOk w
|
||||
identOk t = (not . null) t && all wordOk (split (== '-') t)
|
||||
|
|
@ -38,18 +38,20 @@ checkIdentTemplate =
|
|||
\ASCII letters and digits."
|
||||
in checkBool identOk msg
|
||||
|
||||
checkIdentUnique :: SharerId -> Field Handler Text -> Field Handler Text
|
||||
checkIdentUnique sid = checkM $ \ ident -> do
|
||||
let ident' = text2prj ident
|
||||
checkUniqueCI :: SharerId -> Field Handler PrjIdent -> Field Handler PrjIdent
|
||||
checkUniqueCI sid = checkM $ \ ident -> do
|
||||
sames <- runDB $ select $ from $ \ project -> do
|
||||
where_ $
|
||||
project ^. ProjectSharer ==. val sid &&.
|
||||
lower_ (project ^. ProjectIdent) ==. lower_ (val ident')
|
||||
project ^. ProjectSharer ==. val sid &&.
|
||||
lower_ (project ^. ProjectIdent) ==. lower_ (val ident)
|
||||
limit 1
|
||||
return ()
|
||||
return $ if null sames
|
||||
then Right ident
|
||||
else Left ("You already have a project by that name" :: Text)
|
||||
|
||||
mkIdentField :: SharerId -> Field Handler Text
|
||||
mkIdentField sid = checkIdentUnique sid . checkIdentTemplate $ textField
|
||||
projectIdentField :: Field Handler PrjIdent
|
||||
projectIdentField = convertField text2prj prj2text $ checkTemplate textField
|
||||
|
||||
newProjectIdentField :: SharerId -> Field Handler PrjIdent
|
||||
newProjectIdentField sid = checkUniqueCI sid projectIdentField
|
||||
|
|
|
|||
|
|
@ -14,7 +14,8 @@
|
|||
-}
|
||||
|
||||
module Vervis.Form.Project
|
||||
( newProjectForm
|
||||
( NewProject (..)
|
||||
, newProjectForm
|
||||
, NewProjectCollab (..)
|
||||
, newProjectCollabForm
|
||||
, editProjectForm
|
||||
|
|
@ -32,17 +33,27 @@ import Vervis.Model
|
|||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Repo
|
||||
|
||||
newProjectAForm :: SharerId -> AForm Handler Project
|
||||
newProjectAForm sid = Project
|
||||
<$> (text2prj <$> areq (mkIdentField sid) "Identifier*" Nothing)
|
||||
<*> pure sid
|
||||
<*> aopt textField "Name" Nothing
|
||||
<*> aopt textField "Description" Nothing
|
||||
<*> pure 1
|
||||
<*> pure Nothing
|
||||
data NewProject = NewProject
|
||||
{ npIdent :: PrjIdent
|
||||
, npName :: Maybe Text
|
||||
, npDesc :: Maybe Text
|
||||
, npRole :: ProjectRoleId
|
||||
}
|
||||
|
||||
newProjectForm :: SharerId -> Form Project
|
||||
newProjectForm = renderDivs . newProjectAForm
|
||||
newProjectAForm :: PersonId -> SharerId -> AForm Handler NewProject
|
||||
newProjectAForm pid sid = NewProject
|
||||
<$> areq (newProjectIdentField sid) "Identifier*" Nothing
|
||||
<*> aopt textField "Name" Nothing
|
||||
<*> aopt textField "Description" Nothing
|
||||
<*> areq selectRole "Your role*" Nothing
|
||||
where
|
||||
selectRole =
|
||||
selectField $
|
||||
optionsPersistKey [ProjectRolePerson ==. pid] [] $
|
||||
rl2text . projectRoleIdent
|
||||
|
||||
newProjectForm :: PersonId -> SharerId -> Form NewProject
|
||||
newProjectForm pid sid = renderDivs $ newProjectAForm pid sid
|
||||
|
||||
data NewProjectCollab = NewProjectCollab
|
||||
{ ncPerson :: PersonId
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ import Data.Text (Text)
|
|||
import Database.Persist
|
||||
import Database.Esqueleto hiding (delete, (%), (==.))
|
||||
import Text.Blaze.Html (Html)
|
||||
import Yesod.Auth (requireAuth)
|
||||
import Yesod.Auth (requireAuthId)
|
||||
import Yesod.Core (defaultLayout)
|
||||
import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
|
||||
import Yesod.Form.Functions (runFormPost)
|
||||
|
|
@ -65,15 +65,30 @@ getProjectsR ident = do
|
|||
defaultLayout $(widgetFile "project/list")
|
||||
|
||||
postProjectsR :: ShrIdent -> Handler Html
|
||||
postProjectsR ident = do
|
||||
Entity _pid person <- requireAuth
|
||||
let sid = personIdent person
|
||||
((result, widget), enctype) <- runFormPost $ newProjectForm sid
|
||||
postProjectsR shr = do
|
||||
pid <- requireAuthId
|
||||
Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
|
||||
((result, widget), enctype) <- runFormPost $ newProjectForm pid sid
|
||||
case result of
|
||||
FormSuccess project -> do
|
||||
runDB $ insert_ project
|
||||
FormSuccess np -> do
|
||||
runDB $ do
|
||||
let project = Project
|
||||
{ projectIdent = npIdent np
|
||||
, projectSharer = sid
|
||||
, projectName = npName np
|
||||
, projectDesc = npDesc np
|
||||
, projectNextTicket = 1
|
||||
, projectWiki = Nothing
|
||||
}
|
||||
jid <- insert project
|
||||
let collab = ProjectCollab
|
||||
{ projectCollabProject = jid
|
||||
, projectCollabPerson = pid
|
||||
, projectCollabRole = npRole np
|
||||
}
|
||||
insert_ collab
|
||||
setMessage "Project added."
|
||||
redirect HomeR
|
||||
redirect $ ProjectR shr (npIdent np)
|
||||
FormMissing -> do
|
||||
setMessage "Field(s) missing"
|
||||
defaultLayout $(widgetFile "project/new")
|
||||
|
|
@ -82,10 +97,10 @@ postProjectsR ident = do
|
|||
defaultLayout $(widgetFile "project/new")
|
||||
|
||||
getProjectNewR :: ShrIdent -> Handler Html
|
||||
getProjectNewR ident = do
|
||||
Entity _pid person <- requireAuth
|
||||
let sid = personIdent person
|
||||
((_result, widget), enctype) <- runFormPost $ newProjectForm sid
|
||||
getProjectNewR shr = do
|
||||
pid <- requireAuthId
|
||||
Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
|
||||
((_result, widget), enctype) <- runFormPost $ newProjectForm pid sid
|
||||
defaultLayout $(widgetFile "project/new")
|
||||
|
||||
getProjectR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
|
|
|
|||
|
|
@ -12,8 +12,6 @@ $# 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/>.
|
||||
|
||||
Enter your details and click "Submit" to create a new project.
|
||||
|
||||
<form method=POST action=@{ProjectsR ident} enctype=#{enctype}>
|
||||
<form method=POST action=@{ProjectsR shr} enctype=#{enctype}>
|
||||
^{widget}
|
||||
<input type=submit>
|
||||
|
|
|
|||
Loading…
Reference in a new issue