diff --git a/src/Vervis/Field/Project.hs b/src/Vervis/Field/Project.hs index 737bf49..8bd0cdc 100644 --- a/src/Vervis/Field/Project.hs +++ b/src/Vervis/Field/Project.hs @@ -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 diff --git a/src/Vervis/Form/Project.hs b/src/Vervis/Form/Project.hs index b164d6c..963ee4d 100644 --- a/src/Vervis/Form/Project.hs +++ b/src/Vervis/Form/Project.hs @@ -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 diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index 5f3e2f3..42911ae 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -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 diff --git a/templates/project/new.hamlet b/templates/project/new.hamlet index 704e6a5..d80cb02 100644 --- a/templates/project/new.hamlet +++ b/templates/project/new.hamlet @@ -12,8 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -Enter your details and click "Submit" to create a new project. - -
+ ^{widget}