Projects must specify a ticket workflow

config/models

@@ -136,10 +136,11 @@ ProjectCollabUser
 Project
     ident      PrjIdent
     sharer     SharerId
-    name       Text     Maybe
-    desc       Text     Maybe
+    name       Text       Maybe
+    desc       Text       Maybe
+    workflow   WorkflowId
     nextTicket Int
-    wiki       RepoId   Maybe
+    wiki       RepoId     Maybe
 
     UniqueProject ident sharer
 

src/Vervis/Form/Project.hs

@@ -37,6 +37,7 @@ data NewProject = NewProject
     { npIdent :: PrjIdent
     , npName  :: Maybe Text
     , npDesc  :: Maybe Text
+    , npWflow :: WorkflowId
     , npRole  :: ProjectRoleId
     }
 
@@ -45,12 +46,17 @@ newProjectAForm sid = NewProject
     <$> areq (newProjectIdentField sid) "Identifier*" Nothing
     <*> aopt textField                  "Name"        Nothing
     <*> aopt textField                  "Description" Nothing
+    <*> areq selectWorkflow             "Workflow*"   Nothing
     <*> areq selectRole                 "Your role*"  Nothing
     where
     selectRole =
         selectField $
         optionsPersistKey [ProjectRoleSharer ==. sid] [] $
         rl2text . projectRoleIdent
+    selectWorkflow =
+        selectField $
+        optionsPersistKey [WorkflowSharer ==. sid] [] $
+        \ w -> fromMaybe (wfl2text $ workflowIdent w) $ workflowName w
 
 newProjectForm :: SharerId -> Form NewProject
 newProjectForm sid = renderDivs $ newProjectAForm sid
@@ -90,6 +96,7 @@ editProjectAForm (Entity jid project) = Project
     <*> pure                         (projectSharer project)
     <*> aopt textField "Name"        (Just $ projectName project)
     <*> aopt textField "Description" (Just $ projectDesc project)
+    <*> pure                         (projectWorkflow project)
     <*> pure                         (projectNextTicket project)
     <*> aopt selectWiki "Wiki"       (Just $ projectWiki project)
     where

src/Vervis/Handler/Project.hs

@@ -42,7 +42,7 @@ import Yesod.Core (defaultLayout)
 import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
 import Yesod.Form.Functions (runFormPost)
 import Yesod.Form.Types (FormResult (..))
-import Yesod.Persist.Core (runDB, getBy404)
+import Yesod.Persist.Core (runDB, get404, getBy404)
 
 import qualified Database.Esqueleto as E
 
@@ -53,6 +53,7 @@ import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Settings
 import Vervis.Widget.Sharer
+import Vervis.Widget.Workflow
 
 getProjectsR :: ShrIdent -> Handler Html
 getProjectsR ident = do
@@ -77,6 +78,7 @@ postProjectsR shr = do
                         , projectSharer     = sid
                         , projectName       = npName np
                         , projectDesc       = npDesc np
+                        , projectWorkflow   = npWflow np
                         , projectNextTicket = 1
                         , projectWiki       = Nothing
                         }
@@ -104,11 +106,16 @@ getProjectNewR shr = do
 
 getProjectR :: ShrIdent -> PrjIdent -> Handler Html
 getProjectR shar proj = do
-    (project, repos) <- runDB $ do
-        Entity sid _s <- getBy404 $ UniqueSharer shar
+    (project, workflow, wsharer, repos) <- runDB $ do
+        Entity sid s <- getBy404 $ UniqueSharer shar
         Entity pid p <- getBy404 $ UniqueProject proj sid
+        w <- get404 $ projectWorkflow p
+        sw <-
+            if workflowSharer w == sid
+                then return s
+                else get404 $ workflowSharer w
         rs <- selectList [RepoProject ==. Just pid] [Asc RepoIdent]
-        return (p, rs)
+        return (p, w, sw, rs)
     defaultLayout $(widgetFile "project/one")
 
 putProjectR :: ShrIdent -> PrjIdent -> Handler Html

src/Vervis/Widget/Workflow.hs

@@ -0,0 +1,29 @@
+{- 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.Widget.Workflow
+    ( workflowLinkW
+    )
+where
+
+import Prelude
+
+import Vervis.Foundation
+import Vervis.Model
+import Vervis.Model.Ident (wfl2text)
+import Vervis.Settings (widgetFile)
+
+workflowLinkW :: Sharer -> Workflow -> Widget
+workflowLinkW sharer workflow = $(widgetFile "workflow/widget/link")

templates/project/one.hamlet

@@ -12,10 +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/>.
 
-<p>
-  This is the project page for <b>#{prj2text proj}</b>, shared by
-  <b>#{shr2text shar}</b>.
-
 <p>
   <a href=@{ProjectEditR shar proj}>Edit this project
 
@@ -59,6 +55,11 @@ $else
           $maybe desc <- repoDesc repository
             #{desc}
 
+<h2>Ticket workflow
+
+<p>
+  ^{workflowLinkW wsharer workflow}
+
 <h2>Wiki
 
 <p>

templates/workflow/widget/link.hamlet

@@ -0,0 +1,19 @@
+$# 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/>.
+
+<a href=@{WorkflowR (sharerIdent sharer) (workflowIdent workflow)}>
+  $maybe name <- workflowName workflow
+    #{name}
+  $nothing
+    #{wfl2text $ workflowIdent workflow}

vervis.cabal

@@ -169,6 +169,7 @@ library
                        Vervis.Widget.Role
                        Vervis.Widget.Sharer
                        Vervis.Widget.Ticket
+                       Vervis.Widget.Workflow
                        Vervis.Wiki
   -- other-modules:       
   default-extensions:  TemplateHaskell