Workflow scope field, minimal support

config/models

@@ -166,7 +166,7 @@ Workflow
     ident  WflIdent
     name   Text          Maybe
     desc   Text          Maybe
-    -- scope  WorkflowScope       -- sharer / public / featured
+    scope  WorkflowScope
 
     UniqueWorkflow sharer ident
 

src/Vervis/Form/Project.hs

@@ -26,12 +26,13 @@ import Vervis.Import hiding (on, isNothing)
 
 import Database.Esqueleto hiding ((==.))
 
-import qualified Database.Esqueleto as E ((==.))
+import qualified Database.Esqueleto as E
 
 import Vervis.Field.Project
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Repo
+import Vervis.Model.Workflow
 
 data NewProject = NewProject
     { npIdent :: PrjIdent
@@ -53,10 +54,23 @@ newProjectAForm sid = NewProject
         selectField $
         optionsPersistKey [ProjectRoleSharer ==. sid] [] $
         rl2text . projectRoleIdent
-    selectWorkflow =
-        selectField $
-        optionsPersistKey [WorkflowSharer ==. sid] [] $
-        \ w -> fromMaybe (wfl2text $ workflowIdent w) $ workflowName w
+    selectWorkflow = selectField $ do
+        l <- runDB $ select $ from $ \ (w `InnerJoin` s) -> do
+            on $ w ^. WorkflowSharer E.==. s ^. SharerId
+            where_ $
+                w ^. WorkflowSharer E.==. val sid      E.||.
+                w ^. WorkflowScope  E.!=. val WSSharer
+            return
+                ( s ^. SharerIdent
+                , w ^. WorkflowId
+                , w ^. WorkflowIdent
+                , w ^. WorkflowName
+                )
+        let mkpair (Value sident, Value wid, Value wident, Value wname) =
+                ( shr2text sident <> " / " <> fromMaybe (wfl2text wident) wname
+                , wid
+                )
+        optionsPairs $ map mkpair l
 
 newProjectForm :: SharerId -> Form NewProject
 newProjectForm sid = renderDivs $ newProjectAForm sid

src/Vervis/Form/Workflow.hs

@@ -40,6 +40,7 @@ data NewWorkflow = NewWorkflow
     { nwIdent  :: WflIdent
     , nwName   :: Maybe Text
     , nwDesc   :: Maybe Text
+    , nwPublic :: Bool
     }
 
 newWorkflowAForm :: SharerId -> AForm Handler NewWorkflow
@@ -47,6 +48,7 @@ newWorkflowAForm sid = NewWorkflow
     <$> areq (newWorkflowIdentField sid) "Identifier*" Nothing
     <*> aopt textField                   "Name"        Nothing
     <*> aopt textField                   "Description" Nothing
+    <*> areq checkBoxField               "Public*"     Nothing
 
 newWorkflowForm :: SharerId -> Form NewWorkflow
 newWorkflowForm sid = renderDivs $ newWorkflowAForm sid

src/Vervis/Handler/Workflow.hs

@@ -88,6 +88,8 @@ postWorkflowsR shr = do
                     , workflowIdent  = nwIdent nw
                     , workflowName   = nwName nw
                     , workflowDesc   = nwDesc nw
+                    , workflowScope  =
+                        if nwPublic nw then WSPublic else WSSharer
                     }
             runDB $ insert_ workflow
             setMessage "Workflow added."

src/Vervis/Migration.hs

@@ -65,7 +65,9 @@ runMigrations sb migrations = do
 
 changes :: MonadIO m => [SchemaT SqlBackend m ()]
 changes =
-    [
+    [ addField "Workflow"
+        (Field "scope" (FTPrim SqlString) NotNull)
+        (Just "'WSSharer'")
     ]
 
 migrateDB :: MonadIO m => ReaderT SqlBackend m ()

src/Vervis/Model/Workflow.hs

@@ -14,7 +14,8 @@
  -}
 
 module Vervis.Model.Workflow
-    ( WorkflowFieldType (..)
+    ( WorkflowScope (..)
+    , WorkflowFieldType (..)
     )
 where
 
@@ -22,6 +23,11 @@ import Prelude
 
 import Database.Persist.TH
 
+data WorkflowScope = WSSharer | WSPublic | WSFeatured
+    deriving (Eq, Show, Read, Bounded, Enum)
+
+derivePersistField "WorkflowScope"
+
 data WorkflowFieldType = WFTText | WFTEnum
     deriving (Eq, Show, Read, Bounded, Enum)
 

templates/workflow/one.hamlet

@@ -18,6 +18,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
     <input type="submit" value="Delete this workflow">
 
 <ul>
+  <li>
+    Scope: #{show $ workflowScope w}
   <li>
     Human-friendly name: #{fromMaybe "(none)" $ workflowName w}
   <li>