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