feat(workflows): placeholder handlers

messages/uniworx/de-de-formal.msg

@@ -1383,6 +1383,16 @@ MenuAdminCrontab: Crontab
 MenuAdminWorkflowDefinitionList: Workflows
 MenuAdminWorkflowDefinitionNew: Neue Workflow-Definition
 MenuAdminWorkflowDefinitionDelete: Löschen
+MenuAdminWorkflowInstanceList: Workflow-Instanzen
+MenuAdminWorkflowInstanceNew: Neue Workflow-Instanz
+MenuAdminWorkflowDefinitionInstantiate: Instanziieren
+MenuWorkflowInstanceDelete: Löschen
+MenuWorkflowInstanceWorkflows: Laufende Workflows
+MenuWorkflowInstanceInitiate: Workflow starten
+MenuWorkflowWorkflowEdit: Editieren
+MenuWorkflowWorkflowDelete: Löschen
+MenuGlobalWorkflowInstanceList: Workflows
+MenuGlobalWorkflowWorkflowList: Laufende Workflows
 
 BreadcrumbSubmissionFile: Datei
 BreadcrumbSubmissionUserInvite: Einladung zur Abgabe
@@ -1462,6 +1472,22 @@ BreadcrumbAdminWorkflowDefinitionList: Workflow-Definitionen
 BreadcrumbAdminWorkflowDefinitionNew: Neue Workflow-Definition
 BreadcrumbAdminWorkflowDefinitionEdit renderedWorkflowScope'@Text wfdn@WorkflowDefinitionName: #{wfdn} (#{renderedWorkflowScope'})
 BreadcrumbAdminWorkflowDefinitionDelete: Löschen
+BreadcrumbAdminWorkflowDefinitionInstantiate: Instanziieren
+BreadcrumbAdminWorkflowInstanceList: Workflow-Instanzen
+BreadcrumbAdminWorkflowInstanceNew: Neue Workflow-Instanz
+BreadcrumbAdminWorkflowWorkflowList: Initiierte Workflows
+BreadcrumbAdminWorkflowWorkflowNew: Workflow initiieren
+BreadcrumbWorkflowInstanceEdit win@WorkflowInstanceName: #{win}
+BreadcrumbWorkflowInstanceDelete: Löschen
+BreadcrumbWorkflowInstanceWorkflowList: Laufende Workflows
+BreadcrumbWorkflowInstanceInitiate: Workflow starten
+BreadcrumbWorkflowInstanceList: Workflows
+BreadcrumbWorkflowInstanceNew: Neuer Workflow
+BreadcrumbWorkflowWorkflow workflow@CryptoFileNameWorkflowWorkflow: #{toPathPiece workflow}
+BreadcrumbWorkflowWorkflowEdit: Editieren
+BreadcrumbWorkflowWorkflowDelete: Löschen
+BreadcrumbGlobalWorkflowInstanceList: Workflows
+BreadcrumbGlobalWorkflowWorkflowList: Laufende Workflows
 
 ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn}
 ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn}
@@ -1517,6 +1543,7 @@ AuthTagAuthentication: Nutzer ist angemeldet, falls erforderlich
 AuthTagRead: Zugriff ist nur lesend
 AuthTagWrite: Zugriff ist i.A. schreibend
 AuthTagSubmissionGroup: Nutzer ist Mitglied in registrierter Abgabegruppe
+AuthTagWorkflow: Nutzer hat passende Workflow-Rolle
 
 DeleteCopyStringIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, schreiben Sie bitte zunächst den angezeigten Text ab.
 DeletePressButtonIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, bestätigen Sie dies bitte durch Drücken des untigen Knopfes.
@@ -2842,30 +2869,32 @@ CronMatchNone: Nie
 SystemExamOffice: Prüfungsverwaltung
 SystemFaculty: Fakultätsmitglied
 
-WorkflowInstanceScopeKindGlobal: Systemweit
+WorkflowScopeKindGlobal: Systemweit
-WorkflowInstanceScopeKindTerm: Pro Semester
+WorkflowScopeKindTerm: Pro Semester
-WorkflowInstanceScopeKindSchool: Pro Institut
+WorkflowScopeKindSchool: Pro Institut
-WorkflowInstanceScopeKindTermSchool: Pro Institut & Semester
+WorkflowScopeKindTermSchool: Pro Institut & Semester
-WorkflowInstanceScopeKindCourse: Pro Veranstaltung
+WorkflowScopeKindCourse: Pro Veranstaltung
+WorkflowScopeGlobal: Systemweit
+WorkflowScopeTermSchool tid@TermId ssh@SchoolId: #{tid} #{ssh}
+WorkflowScopeCourse tid@TermId ssh@SchoolId csh@CourseShorthand: #{tid} #{ssh} #{csh}
 WorkflowDefinitionScope: Bereich
 WorkflowDefinitionName: Name
 WorkflowDefinitionDescriptions: Beschreibung
 WorkflowDefinitionDescriptionsLanguageExists: Eine Beschreibung in dieser Sprache existiert bereits
-WorkflowDefinitionDescriptionLanguage: Sprach-Code (RFC1766)
-WorkflowDefinitionDescriptionTitle: Titel
-WorkflowDefinitionDescription: Beschreibung
 WorkflowDefinitionGraph: Spezifikation
 WorkflowDefinitionKeyDoesNotExist renderedCryptoID@Text: Referenziert ID existiert nicht: #{renderedCryptoID}
 WorkflowDefinitionFiles: Dateien
-WorkflowDefinitionFileIdentDoesNotExist fileIdent@Text: Referenzierte Datei existiert nicht: #{fileIdent}
+WorkflowFileIdentDoesNotExist fileIdent@Text: Referenzierte Datei existiert nicht: #{fileIdent}
+WorkflowUserDoesNotExist userIdent@Text: Referenzierter Benutzer existiert nicht: #{userIdent}
 WorkflowDefinitionFileIdentExists: Eine Datei mit dieser ID existiert bereits
 WorkflowDefinitionFileIdent: Dateireferenz
 WorkflowDefinitionFile: Datei
 WorkflowDefinitionCreated: Workflow-Definition angelegt
 WorkflowDefinitionEdited: Workflow-Definition ersetzt
-WorkflowDefinitionCollision: Es existiert bereits eine Workflow-Definition mit diesem Namen
+WorkflowDefinitionCollision: Es existiert bereits eine Workflow-Definition mit diesem Namen und Bereich
 WorkflowDefinitionNewTitle: Workflow-Definition anlegen
 WorkflowDefinitionEditTitle: Workflow-Definition Bearbeiten
+WorkflowDefinitionInstanceCategory: Kategorie
 
 WorkflowDefinitionListTitle: Workflow-Definitionen
 WorkflowDefinitionInstanceCount: Instanzen
@@ -2874,6 +2903,24 @@ WorkflowDefinitionConcreteInstanceCount num@Int64: #{num} Instanzen
 WorkflowDefinitionConcreteWorkflowCount num@Int64: #{num} Workflows
 WorkflowDefinitionDeleteQuestion: Wollen Sie die unten aufgeführte Workflow-Definition wirklich löschen?
 WorkflowDefinitionDeleted: Workflow-Definition gelöscht
+WorkflowDefinitionInstantiateTitle: Workflow-Definition instanziieren
+WorkflowDefinitionInstantiated: Instanz angelegt
+
+WorkflowScope: Bereich
+WorkflowInstanceName: Name
+WorkflowInstanceCategory: Kategorie
+WorkflowInstanceCollision: Es existiert bereits eine Workflow-Instanz mit diesem Namen und Bereich
+WorkflowInstanceListTitle: Workflow-Instanzen
+WorkflowInstanceDescription: Instanz-Beschreibung
+WorkflowInstanceDescriptions: Instanz-Beschreibung
+WorkflowInstanceDescriptionsLanguageExists: Eine Instanz-Beschreibung in dieser Sprache existiert bereits
+WorkflowInstanceCreated: Instanz angelegt
+WorkflowInstanceDescriptionTitle: Instanz-Titel
+WorkflowInstanceWorkflowCount: Workflows
+
+WorkflowDescriptionLanguage: Sprach-Code (RFC1766)
+WorkflowDescriptionTitle: Titel
+WorkflowDescription: Beschreibung
 
 ChangelogItemFeature: Feature
 ChangelogItemBugfix: Bugfix

messages/uniworx/en-eu.msg

@@ -2843,22 +2843,20 @@ CronMatchNone: Never
 SystemExamOffice: Exam office
 SystemFaculty: Faculty member
 
-WorkflowInstanceScopeKindGlobal: Global
+WorkflowScopeKindGlobal: Global
-WorkflowInstanceScopeKindTerm: Per term
+WorkflowScopeKindTerm: Per term
-WorkflowInstanceScopeKindSchool: Per school
+WorkflowScopeKindSchool: Per school
-WorkflowInstanceScopeKindTermSchool: Per school & term
+WorkflowScopeKindTermSchool: Per school & term
-WorkflowInstanceScopeKindCourse: Per course
+WorkflowScopeKindCourse: Per course
 WorkflowDefinitionScope: Scope
 WorkflowDefinitionName: Name
-WorkflowDefinitionDescriptions: Description
+WorkflowDescriptionLanguage: Language code (RFC1766)
-WorkflowDefinitionDescriptionsLanguageExists: A description in this language already exists
+WorkflowDescriptionTitle: Title
-WorkflowDefinitionDescriptionLanguage: Language code (RFC1766)
+WorkflowDescription: Description
-WorkflowDefinitionDescriptionTitle: Title
-WorkflowDefinitionDescription: Description
 WorkflowDefinitionGraph: Specification
 WorkflowDefinitionKeyDoesNotExist renderedCryptoID: Referenced id does not exist: #{renderedCryptoID}
 WorkflowDefinitionFiles: Files
-WorkflowDefinitionFileIdentDoesNotExist fileIdent: Referenced file does not exist: #{fileIdent}
+WorkflowFileIdentDoesNotExist fileIdent: Referenced file does not exist: #{fileIdent}
 WorkflowDefinitionFileIdentExists: A file with the given reference id already exists
 WorkflowDefinitionFileIdent: File reference id
 WorkflowDefinitionFile: File

models/workflows.model

@@ -1,7 +1,8 @@
 WorkflowDefinition
     graph       (WorkflowGraph FileReference SqlBackendKey) -- UserId
-    scope       WorkflowInstanceScope'
+    scope       WorkflowScope'
     name        WorkflowDefinitionName 
+    instanceCategory WorkflowInstanceCategory Maybe
     UniqueWorkflowDefinition name scope
 
 WorkflowDefinitionDescription
@@ -11,16 +12,31 @@ WorkflowDefinitionDescription
     description Html Maybe
     UniqueWorkflowDefinitionDescription definition language
 
+WorkflowDefinitionInstanceDescription
+    definition  WorkflowDefinitionId
+    language    Lang
+    title       Text
+    description Html Maybe
+    UniqueWorkflowDefinitionInstanceDescription definition language
+
 WorkflowInstance
     definition  WorkflowDefinitionId Maybe
     graph       (WorkflowGraph FileReference SqlBackendKey)  -- UserId
-    scope       (WorkflowInstanceScope SqlBackendKey SqlBackendKey SqlBackendKey)  -- TermId, SchoolId, CourseId
+    scope       (WorkflowScope TermIdentifier SchoolShorthand SqlBackendKey)  -- TermId, SchoolId, CourseId
     name        WorkflowInstanceName
     category    WorkflowInstanceCategory Maybe
     UniqueWorkflowInstance name scope
     
+WorkflowInstanceDescription
+    instance    WorkflowInstanceId
+    language    Lang
+    title       Text
+    description Html Maybe
+    UniqueWorkflowInstanceDescription instance language
+
 WorkflowWorkflow
     instance    WorkflowInstanceId Maybe
+    scope       (WorkflowScope TermIdentifier SchoolShorthand SqlBackendKey)  -- TermId, SchoolId, CourseId
     graph       (WorkflowGraph FileReference SqlBackendKey)  -- UserId
     initUser    UserId Maybe
     initTime    UTCTime

routes

@@ -57,11 +57,30 @@
 /admin/errMsg                 AdminErrMsgR     GET POST
 /admin/tokens                 AdminTokensR     GET POST
 /admin/crontab                AdminCrontabR    GET
-/admin/workflow-definitions   AdminWorkflowDefinitionListR  GET
+
-/admin/workflow-definitions/new AdminWorkflowDefinitionNewR GET POST
+/admin/workflows/definitions  AdminWorkflowDefinitionListR GET
-/admin/workflow-definitions/#WorkflowInstanceScope'/#WorkflowDefinitionName AdminWorkflowDefinitionR:
+/admin/workflows/definitions/new AdminWorkflowDefinitionNewR GET POST
-  /edit AWDEditR GET POST
+/admin/workflows/definitions/#WorkflowScope'/#WorkflowDefinitionName AdminWorkflowDefinitionR:
-  /delete AWDDeleteR GET POST
+  /edit                       AWDEditR         GET POST
+  /delete                     AWDDeleteR       GET POST
+  /instantiate                AWDInstantiateR  GET POST
+/admin/workflows/instances    AdminWorkflowInstanceListR GET
+/admin/workflows/instances/new AdminWorkflowInstanceNewR GET POST
+/admin/workflows/workflows    AdminWorkflowWorkflowListR GET
+/admin/workflows/workflows/new AdminWorkflowWorkflowNewR GET POST
+
+/workflow-instances           GlobalWorkflowInstanceListR GET !¬empty
+/workflow-instances/new       GlobalWorkflowInstanceNewR GET POST
+/workflow-instances/#WorkflowInstanceName GlobalWorkflowInstanceR:
+  /edit                       GWIEditR         GET POST
+  /delete                     GWIDeleteR       GET POST
+  /workflows                  GWIWorkflowsR    GET
+  /initiate                   GWIInitiateR     GET POST        !workflow
+/workflows                    GlobalWorkflowWorkflowListR GET  !¬empty
+/workflows/#CryptoFileNameWorkflowWorkflow GlobalWorkflowWorkflowR:
+  /                           GWWWorkflowR     GET POST        !workflow
+  /edit                       GWWEditR         GET POST
+  /delete                     GWWDeleteR       GET POST
 
 /health                       HealthR          GET             !free
 /instance                     InstanceR        GET             !free

src/CryptoID.hs

@@ -73,6 +73,7 @@ decCryptoIDs [ ''SubmissionId
              , ''CourseEventId
              , ''TutorialId
              , ''ExternalExamId
+             , ''WorkflowInstanceId
              , ''WorkflowWorkflowId
              ]
 
@@ -113,3 +114,22 @@ instance {-# OVERLAPS #-} FromJSONKey (E.CryptoID "User" (CI FilePath)) where
   fromJSONKey = FromJSONKeyTextParser $ maybe (fail "Could not parse CryptoFileNameUser") return . fromPathPiece
 instance {-# OVERLAPS #-} ToMarkup (E.CryptoID "User" (CI FilePath)) where
   toMarkup = toMarkup . toPathPiece
+
+  
+-- CryptoIDNamespace (CI FilePath) WorkflowWorkflowId ~ "WorkflowWorkflow"
+instance {-# OVERLAPS #-} PathPiece (E.CryptoID "WorkflowWorkflow" (CI FilePath)) where
+  fromPathPiece (Text.unpack -> piece) = do
+    piece' <- (stripPrefix `on` map CI.mk) "uww" piece
+    return . CryptoID . CI.mk $ map CI.original piece'
+  toPathPiece = Text.pack . ("uww" <>) . CI.foldedCase . ciphertext
+
+instance {-# OVERLAPS #-} ToJSON (E.CryptoID "WorkflowWorkflow" (CI FilePath)) where
+  toJSON = String . toPathPiece
+instance {-# OVERLAPS #-} ToJSONKey (E.CryptoID "WorkflowWorkflow" (CI FilePath)) where
+  toJSONKey = ToJSONKeyText toPathPiece (text . toPathPiece)
+instance {-# OVERLAPS #-} FromJSON (E.CryptoID "WorkflowWorkflow" (CI FilePath)) where
+  parseJSON = withText "CryptoFileNameWorkflowWorkflow" $ maybe (fail "Could not parse CryptoFileNameWorkflowWorkflow") return . fromPathPiece
+instance {-# OVERLAPS #-} FromJSONKey (E.CryptoID "WorkflowWorkflow" (CI FilePath)) where
+  fromJSONKey = FromJSONKeyTextParser $ maybe (fail "Could not parse CryptoFileNameWorkflowWorkflow") return . fromPathPiece
+instance {-# OVERLAPS #-} ToMarkup (E.CryptoID "WorkflowWorkflow" (CI FilePath)) where
+  toMarkup = toMarkup . toPathPiece

src/Foundation/Authorization.hs

@@ -1323,6 +1323,7 @@ tagAccessPredicate AuthAuthentication = APDB $ \mAuthId route _ -> case route of
     guard $ not systemMessageAuthenticatedOnly || isAuthenticated
     return Authorized
   r -> $unsupportedAuthPredicate AuthAuthentication r
+tagAccessPredicate AuthWorkflow = APHandler $ \_ route _ -> $unsupportedAuthPredicate AuthWorkflow route
 tagAccessPredicate AuthRead = APPure $ \_ _ isWrite -> do
   MsgRenderer mr <- ask
   return $ bool Authorized (Unauthorized $ mr MsgUnauthorizedWrite) isWrite

src/Foundation/I18n.hs

@@ -226,7 +226,7 @@ embedRenderMessage ''UniWorX ''ExamOnlinePreset id
 embedRenderMessage ''UniWorX ''ExamSynchronicityPreset id
 embedRenderMessage ''UniWorX ''ExamRequiredEquipmentPreset id
 embedRenderMessage ''UniWorX ''ChangelogItemKind id
-embedRenderMessage ''UniWorX ''WorkflowInstanceScope' $ ("WorkflowInstanceScopeKind" <>) . concat . drop 1 . splitCamel . fromMaybe (error "Expected WorkflowInstanceScope' to have '") . stripSuffix "'"
+embedRenderMessage ''UniWorX ''WorkflowScope' $ ("WorkflowScopeKind" <>) . concat . drop 1 . splitCamel . fromMaybe (error "Expected WorkflowScope' to have '") . stripSuffix "'"
 
 embedRenderMessage ''UniWorX ''AuthenticationMode id
 
@@ -400,6 +400,17 @@ instance RenderMessage UniWorX ShortWeekDay where
 
 embedRenderMessage ''UniWorX ''ButtonSubmit id
 
+instance RenderMessage UniWorX (WorkflowScope TermIdentifier SchoolShorthand (TermId, SchoolId, CourseShorthand)) where
+  renderMessage foundation ls = \case
+    WSGlobal -> mr MsgWorkflowScopeGlobal
+    WSTerm{..} -> mr $ ShortTermIdentifier wisTerm
+    WSSchool{..} -> mr   wisSchool
+    WSTermSchool{..} -> mr $ MsgWorkflowScopeTermSchool (TermKey wisTerm) (SchoolKey wisSchool)
+    WSCourse{ wisCourse = (tid, ssh, csh) } -> mr $ MsgWorkflowScopeCourse tid ssh csh
+    where
+      mr :: forall msg. RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
 
 unRenderMessage' :: (Eq a, Finite a, RenderMessage master a) => (Text -> Text -> Bool) -> master -> Text -> [a]
 unRenderMessage' cmp foundation inp = nub $ do

src/Foundation/Navigation.hs

@@ -338,6 +338,28 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
       MsgRenderer mr <- getMsgRenderer
       i18nCrumb (MsgBreadcrumbAdminWorkflowDefinitionEdit (mr wfdScope) wfdName) $ Just AdminWorkflowDefinitionListR
     AWDDeleteR -> i18nCrumb MsgBreadcrumbAdminWorkflowDefinitionDelete . Just $ AdminWorkflowDefinitionR wfdScope wfdName AWDEditR
+    AWDInstantiateR -> i18nCrumb MsgBreadcrumbAdminWorkflowDefinitionInstantiate . Just $ AdminWorkflowDefinitionR wfdScope wfdName AWDEditR
+  breadcrumb AdminWorkflowInstanceListR = i18nCrumb MsgBreadcrumbAdminWorkflowInstanceList $ Just AdminWorkflowDefinitionListR
+  breadcrumb AdminWorkflowInstanceNewR = i18nCrumb MsgBreadcrumbAdminWorkflowInstanceNew $ Just AdminWorkflowInstanceListR
+  breadcrumb AdminWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbAdminWorkflowWorkflowList $ Just AdminWorkflowInstanceListR
+  breadcrumb AdminWorkflowWorkflowNewR = i18nCrumb MsgBreadcrumbAdminWorkflowWorkflowNew $ Just AdminWorkflowWorkflowListR
+
+  breadcrumb GlobalWorkflowInstanceListR = i18nCrumb MsgBreadcrumbWorkflowInstanceList Nothing
+  breadcrumb GlobalWorkflowInstanceNewR = i18nCrumb MsgBreadcrumbWorkflowInstanceNew $ Just GlobalWorkflowInstanceListR
+  breadcrumb (GlobalWorkflowInstanceR win sRoute) = case sRoute of
+    GWIEditR -> i18nCrumb (MsgBreadcrumbWorkflowInstanceEdit win) $ Just GlobalWorkflowInstanceListR
+    GWIDeleteR -> i18nCrumb MsgBreadcrumbWorkflowInstanceDelete . Just $ GlobalWorkflowInstanceR win GWIEditR
+    GWIWorkflowsR -> i18nCrumb MsgBreadcrumbWorkflowInstanceWorkflowList . Just $ GlobalWorkflowInstanceR win GWIEditR
+    GWIInitiateR -> do
+      mayEdit <- hasReadAccessTo $ GlobalWorkflowInstanceR win GWIEditR
+      i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just $ if
+        | mayEdit -> GlobalWorkflowInstanceR win GWIEditR
+        | otherwise -> GlobalWorkflowInstanceListR
+  breadcrumb GlobalWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbGlobalWorkflowWorkflowList $ Just GlobalWorkflowInstanceListR
+  breadcrumb (GlobalWorkflowWorkflowR cID sRoute) = case sRoute of
+    GWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) $ Just GlobalWorkflowInstanceListR
+    GWWEditR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowEdit . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR
+    GWWDeleteR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowDelete . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR
 
 
 data NavQuickView
@@ -748,6 +770,18 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
               }
           ]
       }
+  , return NavHeader
+      { navHeaderRole = NavHeaderPrimary
+      , navIcon       = IconMenuWorkflows
+      , navLink       = NavLink
+        { navLabel       = MsgMenuGlobalWorkflowInstanceList
+        , navRoute       = GlobalWorkflowInstanceListR
+        , navAccess'     = return True
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      }
   ]
 
 pageActions :: ( MonadHandler m
@@ -2299,6 +2333,17 @@ pageActions AdminWorkflowDefinitionListR = return
       }
     , navChildren = []
     }
+  , NavPageActionPrimary
+    { navLink = NavLink
+      { navLabel       = MsgMenuAdminWorkflowInstanceList
+      , navRoute       = AdminWorkflowInstanceListR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    , navChildren = []
+    }
   ]
 pageActions (AdminWorkflowDefinitionR wds wdn AWDEditR) = return
   [ NavPageActionSecondary
@@ -2311,6 +2356,99 @@ pageActions (AdminWorkflowDefinitionR wds wdn AWDEditR) = return
       , navForceActive = False
       }
     }
+  , NavPageActionPrimary
+    { navLink = NavLink
+      { navLabel       = MsgMenuAdminWorkflowDefinitionInstantiate
+      , navRoute       = AdminWorkflowDefinitionR wds wdn AWDInstantiateR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = True }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    , navChildren = []
+    }
+  ]
+pageActions AdminWorkflowInstanceListR = return
+  [ NavPageActionPrimary
+    { navLink = NavLink
+      { navLabel       = MsgMenuAdminWorkflowInstanceNew
+      , navRoute       = AdminWorkflowInstanceNewR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    , navChildren = []
+    }
+  ]
+pageActions GlobalWorkflowInstanceListR = return
+  [ NavPageActionPrimary
+    { navLink = NavLink
+      { navLabel       = MsgMenuGlobalWorkflowWorkflowList
+      , navRoute       = GlobalWorkflowWorkflowListR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    , navChildren = []
+    }
+  ]
+pageActions (GlobalWorkflowInstanceR win GWIEditR) = return
+  [ NavPageActionSecondary
+    { navLink = NavLink
+      { navLabel       = MsgMenuWorkflowInstanceDelete
+      , navRoute       = GlobalWorkflowInstanceR win GWIDeleteR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    }
+  , NavPageActionPrimary
+    { navLink = NavLink
+      { navLabel       = MsgMenuWorkflowInstanceWorkflows
+      , navRoute       = GlobalWorkflowInstanceR win GWIWorkflowsR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    , navChildren = []
+    }
+  , NavPageActionPrimary
+    { navLink = NavLink
+      { navLabel       = MsgMenuWorkflowInstanceInitiate
+      , navRoute       = GlobalWorkflowInstanceR win GWIInitiateR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    , navChildren = []
+    }
+  ]
+pageActions (GlobalWorkflowWorkflowR cID GWWWorkflowR) = return
+  [ NavPageActionSecondary
+    { navLink = NavLink
+      { navLabel       = MsgMenuWorkflowWorkflowEdit
+      , navRoute       = GlobalWorkflowWorkflowR cID GWWEditR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    }
+  , NavPageActionSecondary
+    { navLink = NavLink
+      { navLabel       = MsgMenuWorkflowWorkflowDelete
+      , navRoute       = GlobalWorkflowWorkflowR cID GWWDeleteR
+      , navAccess'     = return True
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    }
   ]
 pageActions _ = return []
 

src/Foundation/Routes.hs

@@ -39,6 +39,8 @@ deriving instance Generic ExamOfficeR
 deriving instance Generic CourseNewsR
 deriving instance Generic CourseEventR
 deriving instance Generic AdminWorkflowDefinitionR
+deriving instance Generic GlobalWorkflowInstanceR
+deriving instance Generic GlobalWorkflowWorkflowR
 deriving instance Generic (Route UniWorX)
 
 data RouteChildren

src/Foundation/Yesod/Middleware.hs

@@ -147,6 +147,8 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
   , ncTutorial
   , ncExam
   , ncExternalExam
+  , ncAdminWorkflowDefinition
+  , ncGlobalWorkflowInstance
   , verifySubmission
   , verifyCourseApplication
   , verifyCourseNews
@@ -223,6 +225,18 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
       return $ route
         & typesUsing @RouteChildren @CourseName . filtered (== coursen) .~ externalExamCourseName
         & typesUsing @RouteChildren @ExamName . filtered (== examn) .~ externalExamExamName
+    ncAdminWorkflowDefinition = maybeOrig $ \route -> do
+      AdminWorkflowDefinitionR wds wdn _ <- return route
+      Entity _ WorkflowDefinition{..} <- MaybeT . $cachedHereBinary (wds, wdn) . lift . getBy $ UniqueWorkflowDefinition wdn wds
+      caseChanged wdn workflowDefinitionName
+      return $ route
+        & typesUsing @RouteChildren @WorkflowDefinitionName . filtered (== wdn) .~ workflowDefinitionName
+    ncGlobalWorkflowInstance = maybeOrig $ \route -> do
+      GlobalWorkflowInstanceR wdn _ <- return route
+      Entity _ WorkflowInstance{..} <- MaybeT . $cachedHereBinary wdn . lift . getBy $ UniqueWorkflowInstance wdn WSGlobal
+      caseChanged wdn workflowInstanceName
+      return $ route
+        & typesUsing @RouteChildren @WorkflowInstanceName . filtered (== wdn) .~ workflowInstanceName
     verifySubmission = maybeOrig $ \route -> do
       CSubmissionR _tid _ssh _csh _shn cID sr <- return route
       sId <- $cachedHereBinary cID $ decrypt cID
@@ -248,3 +262,5 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
       let newRoute = CNewsR courseTerm courseSchool courseShorthand cID sr
       tell . Any $ route /= newRoute
       return newRoute
+
+    -- TODO: verify*WorkflowWorkflow

src/Handler/Utils/Workflow/Form.hs

@@ -0,0 +1,143 @@
+module Handler.Utils.Workflow.Form
+  ( FileIdent
+  , WorkflowGraphForm(..)
+  , workflowGraphForm
+  , toWorkflowGraphForm, fromWorkflowGraphForm
+  , WorkflowDescriptionsFormScope(..)
+  , workflowDescriptionsForm
+  ) where
+
+import Import
+import Utils.Form
+
+import Handler.Utils.Form
+
+import qualified Data.Conduit.Combinators as C
+
+import qualified Data.Map as Map
+import Data.Map ((!))
+import qualified Data.Set as Set
+import qualified Data.CaseInsensitive as CI
+
+import Data.Bimap (Bimap)
+import qualified Data.Bimap as Bimap
+
+import qualified Control.Monad.State.Class as State
+
+import qualified Data.List.NonEmpty as NonEmpty
+
+
+newtype FileIdent = FileIdent (CI Text)
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving newtype (ToMessage, ToJSON, FromJSON)
+
+makeWrapped ''FileIdent
+  
+data WorkflowGraphForm = WorkflowGraphForm
+  { wgfGraph :: WorkflowGraph FileIdent CryptoUUIDUser
+  , wgfFiles :: Map FileIdent FileReference
+  } deriving (Generic, Typeable)
+
+makeLenses_ ''WorkflowGraphForm
+
+
+workflowGraphForm :: Maybe WorkflowGraphForm -> AForm DB WorkflowGraphForm
+workflowGraphForm template = validateAForm validateWorkflowGraphForm . hoistAForm lift $ WorkflowGraphForm
+  <$> areq yamlField (fslI MsgWorkflowDefinitionGraph) (wgfGraph <$> template)
+  <*> filesForm
+  where
+    filesForm = Map.fromList <$> massInputAccumEditA fileAdd fileEdit (const Nothing) fileLayout ("workflow-definition-files" :: Text) (fslI MsgWorkflowDefinitionFiles) False (Map.toList . wgfFiles <$> template)
+      where fileAdd nudge submitView csrf = do
+              (formRes, formView) <- fileForm nudge Nothing csrf
+              MsgRenderer mr <- getMsgRenderer
+              let res' = formRes <&> \newFile@(newFileIdent, _) oldFiles -> if
+                    | any (\(oldFileIdent, _) -> newFileIdent == oldFileIdent) oldFiles
+                      -> FormFailure [mr MsgWorkflowDefinitionFileIdentExists]
+                    | otherwise
+                      -> FormSuccess $ pure newFile
+              return (res', $(widgetFile "widgets/massinput/workflowDefinitionFiles/add"))
+            fileEdit nudge = fileForm nudge . Just
+            fileForm :: (Text -> Text) -> Maybe (FileIdent, FileReference) -> Form (FileIdent, FileReference)
+            fileForm nudge fileTemplate csrf = do
+              (fileIdentRes, fileIdentView) <- mpreq (isoField _Unwrapped ciField) (fslI MsgWorkflowDefinitionFileIdent & addName (nudge "ident")) (view _1 <$> fileTemplate)
+              (fileRes, fileView) <- mpreq (singleFileField . fromMaybe (return ()) $ views _2 yield <$> fileTemplate) (fslI MsgWorkflowDefinitionFile & addName (nudge "file")) (views _2 yield <$> fileTemplate)
+              fileRes' <- liftHandler . runDB $ case fileRes of
+                FormSuccess uploads -> maybe FormMissing FormSuccess <$> runConduit (transPipe liftHandler uploads .| C.head)
+                FormFailure errs -> return $ FormFailure errs
+                FormMissing -> return FormMissing
+              return ((,) <$> fileIdentRes <*> fileRes', $(widgetFile "widgets/massinput/workflowDefinitionFiles/form"))
+            fileLayout :: MassInputLayout ListLength (FileIdent, FileReference) (FileIdent, FileReference)
+            fileLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/workflowDefinitionFiles/layout")
+
+validateWorkflowGraphForm :: FormValidator WorkflowGraphForm DB ()
+validateWorkflowGraphForm = do
+  fIdentsReferenced <- uses _wgfGraph . setOf $ typesCustom @WorkflowChildren
+  fIdentsAvailable <- uses _wgfFiles Map.keysSet
+  forM_ (fIdentsReferenced `Set.difference` fIdentsAvailable) $ tellValidationError . MsgWorkflowFileIdentDoesNotExist . views _Wrapped CI.original
+
+toWorkflowGraphForm :: ( MonadHandler m, HandlerSite m ~ UniWorX
+                       )
+                    => WorkflowGraph FileReference SqlBackendKey
+                    -> m WorkflowGraphForm
+toWorkflowGraphForm g = liftHandler . fmap (uncurry WorkflowGraphForm . over _2 Bimap.toMap) . (runStateT ?? Bimap.empty) . ($ g)
+    $ traverseOf (typesCustom @WorkflowChildren) recordFile
+  >=> traverseOf (typesCustom @WorkflowChildren @(WorkflowGraph FileIdent SqlBackendKey) @_ @_ @CryptoUUIDUser) (encrypt . review (_SqlKey @User))
+  where
+    recordFile :: forall m. Monad m => FileReference -> StateT (Bimap FileIdent FileReference) m FileIdent
+    recordFile fRef@FileReference{..} = do
+      prev <- State.gets $ Bimap.lookupR fRef
+      case prev of
+        Just fIdent -> return fIdent
+        Nothing -> do
+          cMap <- State.get
+          let candidateIdents = map (review _Wrapped . CI.mk) $
+                map pack $ fileReferenceTitle : [ base <.> show n <.> ext | n <- [1..] :: [Natural], let (base, ext) = splitExtension fileReferenceTitle ]
+              fIdent = case filter (`Bimap.notMember` cMap) candidateIdents of
+                         fIdent' : _ -> fIdent'
+                         [] -> error "candidateIdents should be infinite; cMap should be finite"
+          State.modify $ Bimap.insert fIdent fRef
+          return fIdent
+
+fromWorkflowGraphForm :: (MonadHandler m, HandlerSite m ~ UniWorX)
+                      => WorkflowGraphForm
+                      -> m (WorkflowGraph FileReference SqlBackendKey)
+fromWorkflowGraphForm WorkflowGraphForm{..}
+  = liftHandler $ wgfGraph
+  & over (typesCustom @WorkflowChildren) (wgfFiles !)
+  & traverseOf (typesCustom @WorkflowChildren @(WorkflowGraph FileReference CryptoUUIDUser) @_ @CryptoUUIDUser) (fmap (view $ _SqlKey @User) . decrypt)
+
+
+data WorkflowDescriptionsFormScope
+  = WorkflowDescriptionsFormDefinition
+  | WorkflowDescriptionsFormInstance
+  deriving (Eq, Ord, Bounded, Enum, Read, Show, Generic, Typeable)
+  deriving (Universe, Finite)
+  
+workflowDescriptionsForm :: WorkflowDescriptionsFormScope -> Maybe (Map Lang (Text, Maybe Html)) -> AForm Handler (Map Lang (Text, Maybe Html))
+workflowDescriptionsForm scope template = Map.fromList <$> massInputAccumEditA descrAdd descrEdit (const Nothing) descrLayout ("workflow-descriptions" :: Text) (fslI msgWorkflowDescriptions) False (Map.toList <$> template)
+  where
+    descrAdd nudge submitView csrf = do
+      (formRes, formView) <- descrForm nudge Nothing csrf
+      MsgRenderer mr <- getMsgRenderer
+      let res' = formRes <&> \newDescr@(newLang, _) oldDescrs -> if
+            | any (\(oldLang, _) -> newLang == oldLang) oldDescrs
+              -> FormFailure [mr msgWorkflowDescriptionsLanguageExists]
+            | otherwise
+              -> FormSuccess $ pure newDescr
+      return (res', $(widgetFile "widgets/massinput/workflowDescriptions/add"))
+    descrEdit nudge = descrForm nudge . Just
+    descrForm :: (Text -> Text) -> Maybe (Lang, (Text, Maybe Html)) -> Form (Lang, (Text, Maybe Html))
+    descrForm nudge descrTemplate csrf = do
+      (langRes, langView) <- mpreq (langField False) (fslI MsgWorkflowDescriptionLanguage & addName (nudge "lang")) (fmap (view _1) descrTemplate <|> Just (NonEmpty.head appLanguages))
+      (titleRes, titleView) <- mpreq textField (fslI MsgWorkflowDescriptionTitle & addName (nudge "title")) (view (_2 . _1) <$> descrTemplate)
+      (descrRes, descrView) <- mopt htmlField (fslI MsgWorkflowDescription & addName (nudge "descr")) (view (_2 . _2) <$> descrTemplate)
+      return ((,) <$> langRes <*> ((,) <$> titleRes <*> descrRes), $(widgetFile "widgets/massinput/workflowDescriptions/form"))
+    descrLayout :: MassInputLayout ListLength (Lang, (Text, Maybe Html)) (Lang, (Text, Maybe Html))
+    descrLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/workflowDescriptions/layout")
+
+    msgWorkflowDescriptions = case scope of
+      WorkflowDescriptionsFormDefinition -> MsgWorkflowDefinitionDescriptions
+      WorkflowDescriptionsFormInstance -> MsgWorkflowInstanceDescriptions
+    msgWorkflowDescriptionsLanguageExists = case scope of
+      WorkflowDescriptionsFormDefinition -> MsgWorkflowDefinitionDescriptionsLanguageExists
+      WorkflowDescriptionsFormInstance -> MsgWorkflowInstanceDescriptionsLanguageExists

src/Handler/Utils/Workflow/Workflow.hs

@@ -0,0 +1,17 @@
+module Handler.Utils.Workflow.Workflow
+  ( ensureScope
+  ) where
+
+import Import
+
+
+ensureScope :: WorkflowScope TermId SchoolId CourseId -> CryptoFileNameWorkflowWorkflow -> MaybeT DB WorkflowWorkflowId
+ensureScope wiScope cID = do
+  wId <- catchMaybeT (Proxy @CryptoIDError) $ decrypt cID
+  WorkflowWorkflow{..} <- MaybeT $ get wId
+  let wiScope' = wiScope
+        & _wisTerm   %~ unTermKey
+        & _wisSchool %~ unSchoolKey
+        & _wisCourse %~ view _SqlKey
+  guard $ workflowWorkflowScope == wiScope'
+  return wId

src/Handler/Workflow.hs

@@ -3,3 +3,5 @@ module Handler.Workflow
   ) where
 
 import Handler.Workflow.Definition as Handler.Workflow
+import Handler.Workflow.Instance as Handler.Workflow
+import Handler.Workflow.Workflow as Handler.Workflow

src/Handler/Workflow/Definition.hs

@@ -6,3 +6,4 @@ import Handler.Workflow.Definition.List as Handler.Workflow.Definition
 import Handler.Workflow.Definition.New as Handler.Workflow.Definition
 import Handler.Workflow.Definition.Edit as Handler.Workflow.Definition
 import Handler.Workflow.Definition.Delete as Handler.Workflow.Definition
+import Handler.Workflow.Definition.Instantiate as Handler.Workflow.Definition

src/Handler/Workflow/Definition/Delete.hs

@@ -11,7 +11,7 @@ import qualified Database.Esqueleto as E
 import qualified Data.Set as Set
 
 
-getAWDDeleteR, postAWDDeleteR :: WorkflowInstanceScope' -> WorkflowDefinitionName -> Handler Html
+getAWDDeleteR, postAWDDeleteR :: WorkflowScope' -> WorkflowDefinitionName -> Handler Html
 getAWDDeleteR = postAWDDeleteR
 postAWDDeleteR wds' wdn = do
   wdId <- runDB . getKeyBy404 $ UniqueWorkflowDefinition wdn wds'

src/Handler/Workflow/Definition/Edit.hs

@@ -9,17 +9,9 @@ import Handler.Utils
 import Handler.Workflow.Definition.Form
 
 import qualified Data.Map as Map
-import Data.Map.Strict ((!))
-
-import Data.Bimap (Bimap)
-import qualified Data.Bimap as Bimap
-
-import qualified Control.Monad.State.Class as State
-
-import qualified Data.CaseInsensitive as CI
 
 
-getAWDEditR, postAWDEditR :: WorkflowInstanceScope' -> WorkflowDefinitionName -> Handler Html
+getAWDEditR, postAWDEditR :: WorkflowScope' -> WorkflowDefinitionName -> Handler Html
 getAWDEditR = postAWDEditR
 postAWDEditR wds' wdn = do
   (((_, editForm), editEncoding), act) <- runDB $ do
@@ -31,44 +23,33 @@ postAWDEditR wds' wdn = do
             | Entity _ WorkflowDefinitionDescription{..} <- descs
             ]
       
-      let recordFile :: forall m. Monad m => FileReference -> StateT (Bimap FileIdent FileReference) m FileIdent
+      iDescs <- selectList [WorkflowDefinitionInstanceDescriptionDefinition ==. wdId] []
-          recordFile fRef@FileReference{..} = do
+      let wdfInstanceDescriptions = Map.fromList
-            prev <- State.gets $ Bimap.lookupR fRef
+            [ (workflowDefinitionInstanceDescriptionLanguage, (workflowDefinitionInstanceDescriptionTitle, workflowDefinitionInstanceDescriptionDescription))
-            case prev of
+            | Entity _ WorkflowDefinitionInstanceDescription{..} <- iDescs
-              Just fIdent -> return fIdent
+            ]
-              Nothing -> do
-                cMap <- State.get
-                let candidateIdents = map (review _Wrapped . CI.mk) $
-                      map pack $ fileReferenceTitle : [ base <.> show n <.> ext | n <- [1..] :: [Natural], let (base, ext) = splitExtension fileReferenceTitle ]
-                    fIdent = case filter (`Bimap.notMember` cMap) candidateIdents of
-                               fIdent' : _ -> fIdent'
-                               [] -> error "candidateIdents should be infinite; cMap should be finite"
-                State.modify $ Bimap.insert fIdent fRef
-                return fIdent
 
-      (wdfGraph, Bimap.toMap -> wdfFiles) <- (runStateT ?? Bimap.empty) . ($ workflowDefinitionGraph)
+      wdfGraph <- toWorkflowGraphForm workflowDefinitionGraph
-          $ traverseOf (typesCustom @WorkflowChildren) recordFile
-        >=> traverseOf (typesCustom @WorkflowChildren @(WorkflowGraph FileIdent SqlBackendKey) @_ @_ @CryptoUUIDUser) (encrypt . review (_SqlKey @User))
 
       return WorkflowDefinitionForm
         { wdfScope = workflowDefinitionScope
         , wdfName = workflowDefinitionName
+        , wdfInstanceCategory = workflowDefinitionInstanceCategory
         , wdfDescriptions
+        , wdfInstanceDescriptions
         , wdfGraph
-        , wdfFiles
         }
     
     form@((editRes, _), _) <- runFormPost . workflowDefinitionForm $ Just template
 
     act <- formResultMaybe editRes $ \WorkflowDefinitionForm{..} -> do
-      wdfGraph' <- wdfGraph
+      wdfGraph' <- fromWorkflowGraphForm wdfGraph
-        & over (typesCustom @WorkflowChildren) (wdfFiles !)
-        & traverseOf (typesCustom @WorkflowChildren @(WorkflowGraph FileReference CryptoUUIDUser) @_ @CryptoUUIDUser) (fmap (view $ _SqlKey @User) . decrypt)
       
       insConflict <- replaceUnique wdId WorkflowDefinition
         { workflowDefinitionGraph = wdfGraph'
         , workflowDefinitionScope = wdfScope
         , workflowDefinitionName = wdfName
+        , workflowDefinitionInstanceCategory = wdfInstanceCategory
         }
 
       when (is _Nothing insConflict) . iforM_ wdfDescriptions $ \wddLang (wddTitle, wddDesc) -> do
@@ -79,6 +60,14 @@ postAWDEditR wds' wdn = do
           , workflowDefinitionDescriptionTitle = wddTitle
           , workflowDefinitionDescriptionDescription = wddDesc
           }
+      when (is _Nothing insConflict) . iforM_ wdfInstanceDescriptions $ \wddLang (wddTitle, wddDesc) -> do
+        deleteWhere [WorkflowDefinitionInstanceDescriptionDefinition ==. wdId]
+        insert WorkflowDefinitionInstanceDescription
+          { workflowDefinitionInstanceDescriptionDefinition = wdId
+          , workflowDefinitionInstanceDescriptionLanguage = wddLang
+          , workflowDefinitionInstanceDescriptionTitle = wddTitle
+          , workflowDefinitionInstanceDescriptionDescription = wddDesc
+          }
 
       case insConflict of
         Just (UniqueWorkflowDefinition wdn' wds'') -> return . Just $

src/Handler/Workflow/Definition/Form.hs

@@ -1,103 +1,43 @@
 module Handler.Workflow.Definition.Form
-  ( WorkflowDefinitionForm(..), FileIdent
+  ( WorkflowDefinitionForm(..)
   , workflowDefinitionForm
+  , module Handler.Utils.Workflow.Form
   ) where
 
 import Import
 
 import Handler.Utils
-import qualified Data.List.NonEmpty as NonEmpty
+import Handler.Utils.Workflow.Form
-
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Data.Map ((!))
 
 import qualified Data.CryptoID as C
 
-import qualified Data.CaseInsensitive as CI
-
-import qualified Data.Conduit.Combinators as C
-
-
-newtype FileIdent = FileIdent (CI Text)
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
-  deriving newtype (ToMessage, ToJSON, FromJSON)
-
-makeWrapped ''FileIdent
-  
 
 data WorkflowDefinitionForm = WorkflowDefinitionForm
-  { wdfScope :: WorkflowInstanceScope'
+  { wdfScope :: WorkflowScope'
-  , wdfName  :: CI Text
+  , wdfName  :: WorkflowDefinitionName
+  , wdfInstanceCategory :: Maybe WorkflowInstanceCategory
   , wdfDescriptions :: Map Lang (Text, Maybe Html)
-  , wdfGraph :: WorkflowGraph FileIdent CryptoUUIDUser
+  , wdfInstanceDescriptions :: Map Lang (Text, Maybe Html)
-  , wdfFiles :: Map FileIdent FileReference
+  , wdfGraph :: WorkflowGraphForm
   } deriving (Generic, Typeable)
 
 makeLenses_ ''WorkflowDefinitionForm
 
 workflowDefinitionForm :: Maybe WorkflowDefinitionForm -> Html -> MForm DB (FormResult WorkflowDefinitionForm, Widget)
-workflowDefinitionForm template = validateForm validateWorkflowDefinitionForm . (hoist lift .) . renderAForm FormStandard $ WorkflowDefinitionForm
+workflowDefinitionForm template = validateForm validateWorkflowDefinitionForm . renderAForm FormStandard $ WorkflowDefinitionForm
-  <$> apopt (selectField optionsFinite) (fslI MsgWorkflowDefinitionScope) (wdfScope <$> template)
+  <$> apopt (hoistField lift $ selectField optionsFinite) (fslI MsgWorkflowDefinitionScope) (wdfScope <$> template)
   <*> areq ciField (fslI MsgWorkflowDefinitionName) (wdfName <$> template)
-  <*> descriptionsForm
+  <*> aopt ciField (fslI MsgWorkflowDefinitionInstanceCategory) (wdfInstanceCategory <$> template)
-  <*> areq yamlField (fslI MsgWorkflowDefinitionGraph) (wdfGraph <$> template)
+  <*> hoistAForm lift (workflowDescriptionsForm WorkflowDescriptionsFormDefinition $ wdfDescriptions <$> template)
-  <*> filesForm
+  <*> hoistAForm lift (workflowDescriptionsForm WorkflowDescriptionsFormInstance $ wdfInstanceDescriptions <$> template)
-  where
+  <*> workflowGraphForm (wdfGraph <$> template)
-    descriptionsForm = Map.fromList <$> massInputAccumEditA descrAdd descrEdit (const Nothing) descrLayout ("workflow-definition-descriptions" :: Text) (fslI MsgWorkflowDefinitionDescriptions) False (Map.toList . wdfDescriptions <$> template)
-      where descrAdd nudge submitView csrf = do
-              (formRes, formView) <- descrForm nudge Nothing csrf
-              MsgRenderer mr <- getMsgRenderer
-              let res' = formRes <&> \newDescr@(newLang, _) oldDescrs -> if
-                    | any (\(oldLang, _) -> newLang == oldLang) oldDescrs
-                      -> FormFailure [mr MsgWorkflowDefinitionDescriptionsLanguageExists]
-                    | otherwise
-                      -> FormSuccess $ pure newDescr
-              return (res', $(widgetFile "widgets/massinput/workflowDefinitionDescriptions/add"))
-            descrEdit nudge = descrForm nudge . Just
-            descrForm :: (Text -> Text) -> Maybe (Lang, (Text, Maybe Html)) -> Form (Lang, (Text, Maybe Html))
-            descrForm nudge descrTemplate csrf = do
-              (langRes, langView) <- mpreq (langField False) (fslI MsgWorkflowDefinitionDescriptionLanguage & addName (nudge "lang")) (fmap (view _1) descrTemplate <|> Just (NonEmpty.head appLanguages))
-              (titleRes, titleView) <- mpreq textField (fslI MsgWorkflowDefinitionDescriptionTitle & addName (nudge "title")) (view (_2 . _1) <$> descrTemplate)
-              (descrRes, descrView) <- mopt htmlField (fslI MsgWorkflowDefinitionDescription & addName (nudge "descr")) (view (_2 . _2) <$> descrTemplate)
-              return ((,) <$> langRes <*> ((,) <$> titleRes <*> descrRes), $(widgetFile "widgets/massinput/workflowDefinitionDescriptions/form"))
-            descrLayout :: MassInputLayout ListLength (Lang, (Text, Maybe Html)) (Lang, (Text, Maybe Html))
-            descrLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/workflowDefinitionDescriptions/layout")
-
-    filesForm = Map.fromList <$> massInputAccumEditA fileAdd fileEdit (const Nothing) fileLayout ("workflow-definition-files" :: Text) (fslI MsgWorkflowDefinitionFiles) False (Map.toList . wdfFiles <$> template)
-      where fileAdd nudge submitView csrf = do
-              (formRes, formView) <- fileForm nudge Nothing csrf
-              MsgRenderer mr <- getMsgRenderer
-              let res' = formRes <&> \newFile@(newFileIdent, _) oldFiles -> if
-                    | any (\(oldFileIdent, _) -> newFileIdent == oldFileIdent) oldFiles
-                      -> FormFailure [mr MsgWorkflowDefinitionFileIdentExists]
-                    | otherwise
-                      -> FormSuccess $ pure newFile
-              return (res', $(widgetFile "widgets/massinput/workflowDefinitionFiles/add"))
-            fileEdit nudge = fileForm nudge . Just
-            fileForm :: (Text -> Text) -> Maybe (FileIdent, FileReference) -> Form (FileIdent, FileReference)
-            fileForm nudge fileTemplate csrf = do
-              (fileIdentRes, fileIdentView) <- mpreq (isoField _Unwrapped ciField) (fslI MsgWorkflowDefinitionFileIdent & addName (nudge "ident")) (view _1 <$> fileTemplate)
-              (fileRes, fileView) <- mpreq (singleFileField . fromMaybe (return ()) $ views _2 yield <$> fileTemplate) (fslI MsgWorkflowDefinitionFile & addName (nudge "file")) (views _2 yield <$> fileTemplate)
-              fileRes' <- liftHandler . runDB $ case fileRes of
-                FormSuccess uploads -> maybe FormMissing FormSuccess <$> runConduit (transPipe liftHandler uploads .| C.head)
-                FormFailure errs -> return $ FormFailure errs
-                FormMissing -> return FormMissing
-              return ((,) <$> fileIdentRes <*> fileRes', $(widgetFile "widgets/massinput/workflowDefinitionFiles/form"))
-            fileLayout :: MassInputLayout ListLength (FileIdent, FileReference) (FileIdent, FileReference)
-            fileLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/workflowDefinitionFiles/layout")
-
-    
 
 validateWorkflowDefinitionForm :: FormValidator WorkflowDefinitionForm DB ()
 validateWorkflowDefinitionForm = do
   join . uses _wdfGraph . mapMOf_ (typesCustom @WorkflowChildren) . ensureExists $ Proxy @User
-  fIdentsReferenced <- uses _wdfGraph . setOf $ typesCustom @WorkflowChildren
-  fIdentsAvailable <- uses _wdfFiles Map.keysSet
-  forM_ (fIdentsReferenced `Set.difference` fIdentsAvailable) $ tellValidationError . MsgWorkflowDefinitionFileIdentDoesNotExist . views _Wrapped CI.original
   where
     ensureExists :: forall record ns p r. _ => p record -> C.CryptoID ns UUID -> FormValidator r DB ()
-    ensureExists _ cID = maybeT (tellValidationError . MsgWorkflowDefinitionFileIdentDoesNotExist $ toPathPiece cID) . catchMPlus (Proxy @CryptoIDError) $ do
+    ensureExists _ cID = maybeT (tellValidationError . MsgWorkflowUserDoesNotExist $ toPathPiece cID) . catchMPlus (Proxy @CryptoIDError) $ do
       $logDebugS "validateWorkflowDefinitionForm" $ "Checking key for existence: " <> toPathPiece cID
       key <- decrypt cID
       guardM . lift . lift $ existsKey (key :: Key record)

src/Handler/Workflow/Definition/Instantiate.hs

@@ -0,0 +1,59 @@
+module Handler.Workflow.Definition.Instantiate
+  ( getAWDInstantiateR, postAWDInstantiateR
+  ) where
+
+import Import
+import Handler.Utils
+import Handler.Utils.Workflow.Form
+
+import Handler.Workflow.Instance.Form
+
+
+getAWDInstantiateR, postAWDInstantiateR :: WorkflowScope' -> WorkflowDefinitionName -> Handler Html
+getAWDInstantiateR = postAWDInstantiateR
+postAWDInstantiateR wds' wdn = do
+  (((_, instForm), instEncoding), act) <- runDB $ do
+    wdId <- getKeyBy404 $ UniqueWorkflowDefinition wdn wds'
+    form@((instRes, _), _) <- runFormPost $ workflowInstanceForm (Just wdId) Nothing
+
+    act <- formResultMaybe instRes $ \WorkflowInstanceForm{..} -> do
+      wifGraph' <- fromWorkflowGraphForm wifGraph
+      let wifScope' = wifScope
+            & over _wisTerm   unTermKey
+            & over _wisSchool unSchoolKey
+            & over _wisCourse (view _SqlKey)
+      instId <- insertUnique WorkflowInstance
+        { workflowInstanceDefinition = Just wdId
+        , workflowInstanceGraph = wifGraph'
+        , workflowInstanceScope = wifScope'
+        , workflowInstanceName = wifName
+        , workflowInstanceCategory = wifCategory
+        }
+
+      for_ instId $ \instId' -> iforM_ wifDescriptions $ \widLang (widTitle, widDesc) ->
+        insert WorkflowInstanceDescription
+          { workflowInstanceDescriptionInstance = instId'
+          , workflowInstanceDescriptionLanguage = widLang
+          , workflowInstanceDescriptionTitle = widTitle
+          , workflowInstanceDescriptionDescription = widDesc
+          }
+
+      return . Just $ case instId of
+        Nothing -> addMessageI Error MsgWorkflowInstanceCollision
+        Just _ -> do
+          addMessageI Success MsgWorkflowDefinitionInstantiated
+          redirect AdminWorkflowInstanceListR
+    
+    return (form, act)
+
+  forM_ act id
+
+  let instWidget = wrapForm instForm def
+        { formAction = Just . SomeRoute $ AdminWorkflowDefinitionR wds' wdn AWDInstantiateR
+        , formEncoding = instEncoding
+        }
+
+  siteLayoutMsg MsgWorkflowDefinitionInstantiateTitle $ do
+    setTitleI MsgWorkflowDefinitionInstantiateTitle
+
+    instWidget

src/Handler/Workflow/Definition/List.hs

@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
 
 module Handler.Workflow.Definition.List
-  ( getAdminWorkflowDefinitionListR, postAdminWorkflowDefinitionListR
+  ( getAdminWorkflowDefinitionListR
   ) where
 
 import Import
@@ -35,6 +35,7 @@ queryWorkflowCount = to $ \(view queryWorkflowDefinition -> workflowDefinition)
 type WorkflowDefinitionData = DBRow
   ( Entity WorkflowDefinition
   , Maybe (Entity WorkflowDefinitionDescription)
+  , Maybe (Entity WorkflowDefinitionInstanceDescription)
   , Int64, Int64
   )
 
@@ -44,14 +45,16 @@ resultDefinition = _dbrOutput . _1
 resultDescription :: Traversal' WorkflowDefinitionData (Entity WorkflowDefinitionDescription)
 resultDescription = _dbrOutput . _2 . _Just
   
+resultInstanceDescription :: Traversal' WorkflowDefinitionData (Entity WorkflowDefinitionInstanceDescription)
+resultInstanceDescription = _dbrOutput . _3 . _Just
+
 resultWorkflowInstanceCount, resultWorkflowCount :: Lens' WorkflowDefinitionData Int64
-resultWorkflowInstanceCount = _dbrOutput . _3
+resultWorkflowInstanceCount = _dbrOutput . _4
-resultWorkflowCount = _dbrOutput . _4
+resultWorkflowCount = _dbrOutput . _5
 
 
-getAdminWorkflowDefinitionListR, postAdminWorkflowDefinitionListR :: Handler Html
+getAdminWorkflowDefinitionListR :: Handler Html
-getAdminWorkflowDefinitionListR = postAdminWorkflowDefinitionListR
+getAdminWorkflowDefinitionListR = do
-postAdminWorkflowDefinitionListR = do
   definitionsTable <- runDB $
     let
       workflowDefinitionsDBTable = DBTable{..}
@@ -70,17 +73,24 @@ postAdminWorkflowDefinitionListR = do
               return $ workflowDefinitionDescription E.^. WorkflowDefinitionDescriptionLanguage
             descLang <- traverse selectLanguage . nonEmpty $ E.unValue <$> descLangs
             desc <- lift . fmap join . for descLang $ \descLang' -> getBy $ UniqueWorkflowDefinitionDescription wdId descLang'
-            (wd, desc,,)
+            idescLangs <- lift . E.select . E.from $ \workflowDefinitionInstanceDescription -> do
+              E.where_ $ workflowDefinitionInstanceDescription E.^. WorkflowDefinitionInstanceDescriptionDefinition E.==. E.val wdId
+              return $ workflowDefinitionInstanceDescription E.^. WorkflowDefinitionInstanceDescriptionLanguage
+            idescLang <- traverse selectLanguage . nonEmpty $ E.unValue <$> idescLangs
+            idesc <- lift . fmap join . for idescLang $ \idescLang' -> getBy $ UniqueWorkflowDefinitionInstanceDescription wdId idescLang'
+            (wd, desc, idesc,,)
               <$> view (_2 . _Value)
               <*> view (_3 . _Value)
           dbtColonnade :: Colonnade Sortable WorkflowDefinitionData _
           dbtColonnade = mconcat
             [ sortable (Just "name") (i18nCell MsgWorkflowDefinitionName) . anchorEdit $ views (resultDefinition . _entityVal . _workflowDefinitionName) i18n
             , sortable (Just "scope") (i18nCell MsgWorkflowDefinitionScope) $ views (resultDefinition . _entityVal . _workflowDefinitionScope) i18nCell
-            , sortable (Just "title") (i18nCell MsgWorkflowDefinitionDescriptionTitle) $ maybe mempty (anchorEdit . const . i18n) =<< preview (resultDescription . _entityVal . _workflowDefinitionDescriptionTitle)
+            , sortable (Just "title") (i18nCell MsgWorkflowDescriptionTitle) $ maybe mempty (anchorEdit . const . i18n) =<< preview (resultDescription . _entityVal . _workflowDefinitionDescriptionTitle)
             , sortable (Just "instances") (i18nCell MsgWorkflowDefinitionInstanceCount) $ maybe mempty i18nCell . views resultWorkflowInstanceCount (assertM' (> 0))
             , sortable (Just "workflows") (i18nCell MsgWorkflowDefinitionWorkflowCount) $ maybe mempty i18nCell . views resultWorkflowCount (assertM' (> 0))
-            , sortable (Just "description") (i18nCell MsgWorkflowDefinitionDescription) $ maybe mempty modalCell . preview (resultDescription . _entityVal . _workflowDefinitionDescriptionDescription . _Just)
+            , sortable (Just "description") (i18nCell MsgWorkflowDescription) $ maybe mempty modalCell . preview (resultDescription . _entityVal . _workflowDefinitionDescriptionDescription . _Just)
+            , sortable (Just "instance-title") (i18nCell MsgWorkflowInstanceDescriptionTitle) $ maybe mempty (anchorEdit . const . i18n) =<< preview (resultInstanceDescription . _entityVal . _workflowDefinitionInstanceDescriptionTitle)
+            , sortable (Just "instance-description") (i18nCell MsgWorkflowInstanceDescription) $ maybe mempty modalCell . preview (resultInstanceDescription . _entityVal . _workflowDefinitionInstanceDescriptionDescription . _Just)
             , sortable Nothing (i18nCell MsgWorkflowDefinitionGraph) $ views (resultDefinition . _entityVal . _workflowDefinitionGraph) (modalCell . displayGraph)
             ]
             where
@@ -98,6 +108,8 @@ postAdminWorkflowDefinitionListR = do
             , singletonMap "scope" . SortColumn . views queryWorkflowDefinition $ E.orderByEnum . (E.^. WorkflowDefinitionScope)
             , singletonMap "title" . SortProjected . comparing . view $ resultDescription . _entityVal . _workflowDefinitionDescriptionTitle
             , singletonMap "description" . SortProjected . comparing . view $ resultDescription . _entityVal . _workflowDefinitionDescriptionDescription
+            , singletonMap "instance-title" . SortProjected . comparing . view $ resultInstanceDescription . _entityVal . _workflowDefinitionInstanceDescriptionTitle
+            , singletonMap "instance-description" . SortProjected . comparing . view $ resultInstanceDescription . _entityVal . _workflowDefinitionInstanceDescriptionDescription
             , singletonMap "instances" . SortColumn $ view queryWorkflowInstanceCount
             , singletonMap "workflows" . SortColumn $ view queryWorkflowCount
             ]
@@ -105,11 +117,13 @@ postAdminWorkflowDefinitionListR = do
             [ singletonMap "name" . FilterColumn $ E.mkContainsFilter (E.^. WorkflowDefinitionName)
             , singletonMap "scope" . FilterColumn $ E.mkExactFilter (E.^. WorkflowDefinitionScope)
             , singletonMap "title" . FilterProjected $ \(ts :: Set Text) (view $ resultDescription . _entityVal . _workflowDefinitionDescriptionTitle -> t) -> oany ((flip isInfixOf `on` CI.foldCase) t) ts
+            , singletonMap "instance-title" . FilterProjected $ \(ts :: Set Text) (view $ resultInstanceDescription . _entityVal . _workflowDefinitionInstanceDescriptionTitle -> t) -> oany ((flip isInfixOf `on` CI.foldCase) t) ts
             ]
           dbtFilterUI mPrev = mconcat
             [ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgWorkflowDefinitionName)
-            , prismAForm (singletonFilter "scope" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgNoFilter) optionsFinite :: Field _ WorkflowInstanceScope') (fslI MsgWorkflowDefinitionScope)
+            , prismAForm (singletonFilter "scope" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgNoFilter) optionsFinite :: Field _ WorkflowScope') (fslI MsgWorkflowDefinitionScope)
-            , prismAForm (singletonFilter "title") mPrev $ aopt textField (fslI MsgWorkflowDefinitionDescriptionTitle)
+            , prismAForm (singletonFilter "title") mPrev $ aopt textField (fslI MsgWorkflowDescriptionTitle)
+            , prismAForm (singletonFilter "instance-title") mPrev $ aopt textField (fslI MsgWorkflowInstanceDescriptionTitle)
             ]
           dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
           dbtParams = def

src/Handler/Workflow/Definition/New.hs

@@ -6,8 +6,6 @@ import Import
 import Handler.Utils
 import Handler.Workflow.Definition.Form
 
-import Data.Map.Strict ((!))
-  
 
 getAdminWorkflowDefinitionNewR, postAdminWorkflowDefinitionNewR :: Handler Html
 getAdminWorkflowDefinitionNewR = postAdminWorkflowDefinitionNewR
@@ -15,15 +13,14 @@ postAdminWorkflowDefinitionNewR = do
   (((_, newForm), newEncoding), act) <- runDB $ do
     form@((newRes, _), _) <- runFormPost $ workflowDefinitionForm Nothing
 
-    act <- formResultMaybe newRes $ \WorkflowDefinitionForm{..} -> do
+    act <- formResultMaybe newRes $ \WorkflowDefinitionForm{ .. } -> do
-      wdfGraph' <- wdfGraph
+      wdfGraph' <- fromWorkflowGraphForm wdfGraph
-        & over (typesCustom @WorkflowChildren) (wdfFiles !)
-        & traverseOf (typesCustom @WorkflowChildren @(WorkflowGraph FileReference CryptoUUIDUser) @_ @CryptoUUIDUser) (fmap (view $ _SqlKey @User) . decrypt)
       
       insRes <- insertUnique WorkflowDefinition
         { workflowDefinitionGraph = wdfGraph'
         , workflowDefinitionScope = wdfScope
         , workflowDefinitionName = wdfName
+        , workflowDefinitionInstanceCategory = wdfInstanceCategory
         }
 
       for_ insRes $ \wdId -> iforM_ wdfDescriptions $ \wddLang (wddTitle, wddDesc) ->
@@ -33,6 +30,13 @@ postAdminWorkflowDefinitionNewR = do
           , workflowDefinitionDescriptionTitle = wddTitle
           , workflowDefinitionDescriptionDescription = wddDesc
           }
+      for_ insRes $ \wdId -> iforM_ wdfInstanceDescriptions $ \wddLang (wddTitle, wddDesc) ->
+        insert WorkflowDefinitionInstanceDescription
+          { workflowDefinitionInstanceDescriptionDefinition = wdId
+          , workflowDefinitionInstanceDescriptionLanguage = wddLang
+          , workflowDefinitionInstanceDescriptionTitle = wddTitle
+          , workflowDefinitionInstanceDescriptionDescription = wddDesc
+          }
 
       case insRes of
         Just _ -> return . Just $ do

src/Handler/Workflow/Instance.hs

@@ -0,0 +1,9 @@
+module Handler.Workflow.Instance
+  ( module Handler.Workflow.Instance
+  ) where
+
+import Handler.Workflow.Instance.List as Handler.Workflow.Instance
+import Handler.Workflow.Instance.New as Handler.Workflow.Instance
+import Handler.Workflow.Instance.Edit as Handler.Workflow.Instance
+import Handler.Workflow.Instance.Delete as Handler.Workflow.Instance
+import Handler.Workflow.Instance.Initiate as Handler.Workflow.Instance

src/Handler/Workflow/Instance/Delete.hs

@@ -0,0 +1,15 @@
+module Handler.Workflow.Instance.Delete
+  ( getGWIDeleteR, postGWIDeleteR 
+  , workflowInstanceDeleteR
+  ) where
+
+import Import
+
+
+getGWIDeleteR, postGWIDeleteR :: WorkflowInstanceName -> Handler Html
+getGWIDeleteR = postGWIDeleteR
+postGWIDeleteR win
+  = workflowInstanceDeleteR <=< runDB . getKeyBy404 $ UniqueWorkflowInstance win WSGlobal
+
+workflowInstanceDeleteR :: WorkflowInstanceId -> Handler Html
+workflowInstanceDeleteR = error "not implemented"

src/Handler/Workflow/Instance/Edit.hs

@@ -0,0 +1,15 @@
+module Handler.Workflow.Instance.Edit
+  ( getGWIEditR, postGWIEditR 
+  , workflowInstanceEditR
+  ) where
+
+import Import
+
+
+getGWIEditR, postGWIEditR :: WorkflowInstanceName -> Handler Html
+getGWIEditR = postGWIEditR
+postGWIEditR win
+  = workflowInstanceEditR <=< runDB . getKeyBy404 $ UniqueWorkflowInstance win WSGlobal
+
+workflowInstanceEditR :: WorkflowInstanceId -> Handler Html
+workflowInstanceEditR = error "not implemented"

src/Handler/Workflow/Instance/Form.hs

@@ -0,0 +1,79 @@
+module Handler.Workflow.Instance.Form
+  ( WorkflowInstanceForm(..), FileIdent
+  , workflowInstanceForm
+  ) where
+
+import Import
+
+import Handler.Utils
+
+import Handler.Utils.Workflow.Form
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+
+workflowInstanceScopeForm :: Maybe WorkflowScope'
+                          -> FieldSettings UniWorX
+                          -> Maybe (WorkflowScope TermId SchoolId CourseId)
+                          -> AForm Handler (WorkflowScope TermId SchoolId CourseId)
+workflowInstanceScopeForm scopeRestr fs mPrev = multiActionA scopeOptions' fs $ classifyWorkflowScope <$> mPrev
+  where
+    scopeOptions' = maybe id (flip Map.restrictKeys . Set.singleton) scopeRestr scopeOptions
+    scopeOptions = Map.fromList
+      [ ( WSGlobal'
+        , pure WSGlobal
+        )
+      , ( WSTerm'
+        , WSTerm <$> apopt termField (fslI MsgTerm) (mPrev ^? _Just . _wisTerm)
+        )
+      , ( WSSchool'
+        , WSSchool <$> apopt schoolField (fslI MsgSchool) (mPrev ^? _Just . _wisSchool)
+        )
+      , ( WSTermSchool'
+        , WSTermSchool <$> apopt termField (fslI MsgTerm) (mPrev ^? _Just . _wisTerm)
+                        <*> apopt schoolField (fslI MsgSchool) (mPrev ^? _Just . _wisSchool)
+        )
+      , ( WSCourse'
+        , WSCourse <$> apopt (selectField' Nothing courseOptions) (fslI MsgCourse) (mPrev ^? _Just . _wisCourse)
+        )
+      ]
+      where courseOptions = fmap (fmap entityKey) . optionsPersistCryptoId [] [ Desc CourseTerm, Asc CourseSchool, Asc CourseName ] $ \Course{..} -> MsgCourseOption courseTerm courseSchool courseName
+
+
+data WorkflowInstanceForm = WorkflowInstanceForm
+  { wifScope :: WorkflowScope TermId SchoolId CourseId
+  , wifName :: WorkflowInstanceName
+  , wifCategory :: Maybe WorkflowInstanceCategory
+  , wifDescriptions :: Map Lang (Text, Maybe Html)
+  , wifGraph :: WorkflowGraphForm
+  } deriving (Generic, Typeable)
+
+makeLenses_ ''WorkflowInstanceForm
+
+workflowInstanceForm :: Maybe WorkflowDefinitionId
+                     -> Maybe WorkflowInstanceForm
+                     -> Html
+                     -> MForm DB (FormResult WorkflowInstanceForm, Widget)
+workflowInstanceForm forcedDefId template = renderWForm FormStandard $ do
+  defEnt <- for forcedDefId $ lift . lift . getJustEntity
+  defDescs <- for defEnt $ \(Entity dId _) -> do
+    descs <- lift . lift $ selectList [WorkflowDefinitionInstanceDescriptionDefinition ==. dId] []
+    return $ Map.fromList
+      [ (workflowDefinitionInstanceDescriptionLanguage, (workflowDefinitionInstanceDescriptionTitle, workflowDefinitionInstanceDescriptionDescription))
+      | Entity _ WorkflowDefinitionInstanceDescription{..} <- descs
+      ]
+  defGraph <- for defEnt $ toWorkflowGraphForm . workflowDefinitionGraph . entityVal
+
+  wifScopeRes <- aFormToWForm . hoistAForm lift $ workflowInstanceScopeForm (workflowDefinitionScope . entityVal <$> defEnt) (fslI MsgWorkflowScope) (wifScope <$> template)
+  wifNameRes <- wreq ciField (fslI MsgWorkflowInstanceName) (fmap wifName template <|> fmap (workflowDefinitionName . entityVal) defEnt)
+  wifCategoryRes <- wopt ciField (fslI MsgWorkflowInstanceCategory) (fmap wifCategory template <|> fmap (workflowDefinitionInstanceCategory . entityVal) defEnt)
+  wifDescriptions <- aFormToWForm . hoistAForm lift $ workflowDescriptionsForm WorkflowDescriptionsFormDefinition (fmap wifDescriptions template <|> defDescs)
+  wifGraphRes <- aFormToWForm $ workflowGraphForm ((template ^? _Just . _wifGraph) <|> defGraph)
+
+  return $ WorkflowInstanceForm
+    <$> wifScopeRes
+    <*> wifNameRes
+    <*> wifCategoryRes
+    <*> wifDescriptions
+    <*> wifGraphRes

src/Handler/Workflow/Instance/Initiate.hs

@@ -0,0 +1,15 @@
+module Handler.Workflow.Instance.Initiate
+  ( getGWIInitiateR, postGWIInitiateR 
+  , workflowInstanceInitiateR
+  ) where
+
+import Import
+
+
+getGWIInitiateR, postGWIInitiateR :: WorkflowInstanceName -> Handler Html
+getGWIInitiateR = postGWIInitiateR
+postGWIInitiateR win
+  = workflowInstanceInitiateR <=< runDB . getKeyBy404 $ UniqueWorkflowInstance win WSGlobal
+
+workflowInstanceInitiateR :: WorkflowInstanceId -> Handler Html
+workflowInstanceInitiateR = error "not implemented"

src/Handler/Workflow/Instance/List.hs

@@ -0,0 +1,125 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
+module Handler.Workflow.Instance.List
+  ( getAdminWorkflowInstanceListR
+  , getGlobalWorkflowInstanceListR
+  , workflowInstanceListR
+  ) where
+
+import Import
+  
+import Handler.Utils
+
+import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
+
+import qualified Data.CaseInsensitive as CI
+
+
+type WorkflowInstanceTableExpr = E.SqlExpr (Entity WorkflowInstance)
+
+queryWorkflowInstance :: Equality' WorkflowInstanceTableExpr (E.SqlExpr (Entity WorkflowInstance))
+queryWorkflowInstance = id
+
+queryWorkflowCount :: Getter WorkflowInstanceTableExpr (E.SqlExpr (E.Value Int64))
+queryWorkflowCount = to $ \(view queryWorkflowInstance -> workflowInstance) ->
+  E.subSelectCount . E.from $ \workflow ->
+    E.where_ $ workflow E.^. WorkflowWorkflowInstance E.==. E.just (workflowInstance E.^. WorkflowInstanceId)
+
+
+type WorkflowInstanceData = DBRow
+  ( Entity WorkflowInstance
+  , Maybe (Entity WorkflowInstanceDescription)
+  , Int64
+  )
+
+resultWorkflowInstance :: Lens' WorkflowInstanceData (Entity WorkflowInstance)
+resultWorkflowInstance = _dbrOutput . _1
+
+resultDescription :: Traversal' WorkflowInstanceData (Entity WorkflowInstanceDescription)
+resultDescription = _dbrOutput . _2 . _Just
+
+resultWorkflowCount :: Lens' WorkflowInstanceData Int64
+resultWorkflowCount = _dbrOutput . _3
+  
+
+getAdminWorkflowInstanceListR :: Handler Html
+getAdminWorkflowInstanceListR = do
+  instancesTable <- runDB $ do
+    scopeOptions <- do
+      scopes <- fmap (map E.unValue) . E.select . E.from $ \workflowInstance ->
+        return $ workflowInstance E.^. WorkflowInstanceScope
+      fmap mkOptionList . for scopes $ \scope -> do
+        eScope <- traverseOf _wisCourse (encrypt . (review _SqlKey :: SqlBackendKey -> CourseId)) scope :: DB (WorkflowScope TermIdentifier SchoolShorthand CryptoUUIDCourse)
+        wScope <- forOf _wisCourse scope $ fmap ((,,) <$> courseTerm <*> courseSchool <*> courseShorthand) . getJust . review _SqlKey
+        MsgRenderer mr <- getMsgRenderer
+        return Option
+          { optionDisplay = mr wScope
+          , optionInternalValue = scope
+          , optionExternalValue = toPathPiece eScope
+          }
+    
+    let workflowInstancesDBTable = DBTable{..}
+          where
+            dbtSQLQuery = runReaderT $ do
+              workflowInstance <- view queryWorkflowInstance
+              workflowCount <- view queryWorkflowCount
+          
+              return (workflowInstance, workflowCount)
+            dbtRowKey = (E.^. WorkflowInstanceId)
+            dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ do
+              wi@(Entity wiId _) <- view _1
+              descLangs <- lift . E.select . E.from $ \workflowInstanceDescription -> do
+                E.where_ $ workflowInstanceDescription E.^. WorkflowInstanceDescriptionInstance E.==. E.val wiId
+                return $ workflowInstanceDescription E.^. WorkflowInstanceDescriptionLanguage
+              descLang <- traverse selectLanguage . nonEmpty $ E.unValue <$> descLangs
+              desc <- lift . fmap join . for descLang $ \descLang' -> getBy $ UniqueWorkflowInstanceDescription wiId descLang'
+              (wi, desc,)
+                <$> view (_2 . _Value)
+            dbtColonnade :: Colonnade Sortable WorkflowInstanceData _
+            dbtColonnade = mconcat
+              [ sortable (Just "name") (i18nCell MsgWorkflowInstanceName) $ views (resultWorkflowInstance . _entityVal . _workflowInstanceName) i18nCell
+              , sortable (Just "scope") (i18nCell MsgWorkflowScope) . views (resultWorkflowInstance . _entityVal . _workflowInstanceScope) $ \scope ->
+                  sqlCell . fmap i18n . forOf _wisCourse scope $ fmap ((,,) <$> courseTerm <*> courseSchool <*> courseShorthand) . getJust . review _SqlKey
+              , sortable (Just "title") (i18nCell MsgWorkflowInstanceDescriptionTitle) $ maybe mempty i18nCell . preview (resultDescription . _entityVal . _workflowInstanceDescriptionTitle)
+              , sortable (Just "workflows") (i18nCell MsgWorkflowInstanceWorkflowCount) $ maybe mempty i18nCell . views resultWorkflowCount (assertM' (> 0))
+              , sortable (Just "description") (i18nCell MsgWorkflowInstanceDescription) $ maybe mempty modalCell . preview (resultDescription . _entityVal . _workflowInstanceDescriptionDescription . _Just)
+              ]
+            dbtSorting = mconcat
+              [ singletonMap "name" . SortColumn $ views queryWorkflowInstance (E.^. WorkflowInstanceName)
+              , singletonMap "scope" . SortColumn $ views queryWorkflowInstance (E.^. WorkflowInstanceScope)
+              , singletonMap "title" . SortProjected . comparing . view $ resultDescription . _entityVal . _workflowInstanceDescriptionTitle
+              , singletonMap "description" . SortProjected . comparing . view $ resultDescription . _entityVal . _workflowInstanceDescriptionDescription
+              , singletonMap "workflows" . SortColumn $ view queryWorkflowCount
+              ]
+            dbtFilter = mconcat
+              [ singletonMap "name" . FilterColumn $ E.mkContainsFilter (E.^. WorkflowInstanceName)
+              , singletonMap "scope" . FilterColumn $ E.mkExactFilter (E.^. WorkflowInstanceScope)
+              , singletonMap "title" . FilterProjected $ \(ts :: Set Text) (view $ resultDescription . _entityVal . _workflowInstanceDescriptionTitle -> t) -> oany ((flip isInfixOf `on` CI.foldCase) t) ts
+              ]
+            dbtFilterUI mPrev = mconcat
+              [ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgWorkflowInstanceName)
+              , prismAForm (singletonFilter "scope" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgNoFilter) $ return scopeOptions) (fslI MsgWorkflowScope)
+              , prismAForm (singletonFilter "title") mPrev $ aopt textField (fslI MsgWorkflowInstanceDescriptionTitle)
+              ]
+            dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
+            dbtParams = def
+            dbtIdent :: Text
+            dbtIdent = "workflow-instances"
+            dbtCsvEncode = noCsvEncode
+            dbtCsvDecode = Nothing
+        workflowInstancesDBTableValidator = def
+          & defaultSorting [SortAscBy "scope", SortAscBy "name"]
+     in dbTableDB' workflowInstancesDBTableValidator workflowInstancesDBTable
+
+  siteLayoutMsg MsgWorkflowInstanceListTitle $ do
+    setTitleI MsgWorkflowInstanceListTitle
+
+    instancesTable
+
+  
+getGlobalWorkflowInstanceListR :: Handler Html
+getGlobalWorkflowInstanceListR = workflowInstanceListR WSGlobal
+
+workflowInstanceListR :: WorkflowScope TermId SchoolId CourseId -> Handler Html
+workflowInstanceListR = error "not implemented"

src/Handler/Workflow/Instance/New.hs

@@ -0,0 +1,76 @@
+module Handler.Workflow.Instance.New
+  ( getAdminWorkflowInstanceNewR, postAdminWorkflowInstanceNewR
+  , adminWorkflowInstanceNewR
+  , getGlobalWorkflowInstanceNewR, postGlobalWorkflowInstanceNewR
+  , workflowInstanceNewR
+  ) where
+
+import Import
+import Handler.Utils
+import Handler.Utils.Workflow.Form
+
+import Handler.Workflow.Instance.Form
+
+getAdminWorkflowInstanceNewR, postAdminWorkflowInstanceNewR :: Handler Html
+getAdminWorkflowInstanceNewR = postAdminWorkflowInstanceNewR
+postAdminWorkflowInstanceNewR = adminWorkflowInstanceNewR Nothing
+
+adminWorkflowInstanceNewR :: Maybe WorkflowDefinitionId -> Handler Html
+adminWorkflowInstanceNewR wdId = do
+  cRoute <- getCurrentRoute
+  (((_, instForm), instEncoding), act) <- runDB $ do
+    form@((instRes, _), _) <- runFormPost $ workflowInstanceForm wdId Nothing
+
+    act <- formResultMaybe instRes $ \WorkflowInstanceForm{..} -> do
+      wifGraph' <- fromWorkflowGraphForm wifGraph
+      let wifScope' = wifScope
+            & over _wisTerm   unTermKey
+            & over _wisSchool unSchoolKey
+            & over _wisCourse (view _SqlKey)
+      instId <- insertUnique WorkflowInstance
+        { workflowInstanceDefinition = wdId
+        , workflowInstanceGraph = wifGraph'
+        , workflowInstanceScope = wifScope'
+        , workflowInstanceName = wifName
+        , workflowInstanceCategory = wifCategory
+        }
+
+      for_ instId $ \instId' -> iforM_ wifDescriptions $ \widLang (widTitle, widDesc) ->
+        insert WorkflowInstanceDescription
+          { workflowInstanceDescriptionInstance = instId'
+          , workflowInstanceDescriptionLanguage = widLang
+          , workflowInstanceDescriptionTitle = widTitle
+          , workflowInstanceDescriptionDescription = widDesc
+          }
+
+      return . Just $ case instId of
+        Nothing -> addMessageI Error MsgWorkflowInstanceCollision
+        Just _
+          | is _Just wdId -> do
+              addMessageI Success MsgWorkflowDefinitionInstantiated
+              redirect AdminWorkflowInstanceListR
+          | otherwise -> do
+              addMessageI Success MsgWorkflowInstanceCreated
+              redirect AdminWorkflowInstanceListR
+    
+    return (form, act)
+
+  forM_ act id
+
+  let instWidget = wrapForm instForm def
+        { formAction = SomeRoute <$> cRoute
+        , formEncoding = instEncoding
+        }
+
+  siteLayoutMsg MsgWorkflowDefinitionInstantiateTitle $ do
+    setTitleI MsgWorkflowDefinitionInstantiateTitle
+
+    instWidget
+
+
+getGlobalWorkflowInstanceNewR, postGlobalWorkflowInstanceNewR :: Handler Html
+getGlobalWorkflowInstanceNewR = postGlobalWorkflowInstanceNewR
+postGlobalWorkflowInstanceNewR = workflowInstanceNewR WSGlobal
+
+workflowInstanceNewR :: WorkflowScope TermId SchoolId CourseId -> Handler Html
+workflowInstanceNewR = error "not implemented"

src/Handler/Workflow/Workflow.hs

@@ -0,0 +1,9 @@
+module Handler.Workflow.Workflow
+  ( module Handler.Workflow.Workflow
+  ) where
+
+import Handler.Workflow.Workflow.List as Handler.Workflow.Workflow
+import Handler.Workflow.Workflow.Workflow as Handler.Workflow.Workflow
+import Handler.Workflow.Workflow.Edit as Handler.Workflow.Workflow
+import Handler.Workflow.Workflow.Delete as Handler.Workflow.Workflow
+import Handler.Workflow.Workflow.New as Handler.Workflow.Workflow

src/Handler/Workflow/Workflow/Delete.hs

@@ -0,0 +1,17 @@
+module Handler.Workflow.Workflow.Delete
+  ( getGWWDeleteR, postGWWDeleteR
+  , workflowDeleteR
+  ) where
+
+import Import
+
+import Handler.Utils.Workflow.Workflow
+
+
+getGWWDeleteR, postGWWDeleteR :: CryptoFileNameWorkflowWorkflow -> Handler Html
+getGWWDeleteR = postGWWDeleteR
+postGWWDeleteR cID
+  = workflowDeleteR <=< runDB . maybeT notFound $ ensureScope WSGlobal cID
+
+workflowDeleteR :: WorkflowWorkflowId -> Handler Html
+workflowDeleteR = error "not implemented"

src/Handler/Workflow/Workflow/Edit.hs

@@ -0,0 +1,17 @@
+module Handler.Workflow.Workflow.Edit
+  ( getGWWEditR, postGWWEditR
+  , workflowEditR
+  ) where
+
+import Import
+
+import Handler.Utils.Workflow.Workflow
+
+
+getGWWEditR, postGWWEditR :: CryptoFileNameWorkflowWorkflow -> Handler Html
+getGWWEditR = postGWWEditR
+postGWWEditR cID
+  = workflowEditR <=< runDB . maybeT notFound $ ensureScope WSGlobal cID
+
+workflowEditR :: WorkflowWorkflowId -> Handler Html
+workflowEditR = error "not implemented"

src/Handler/Workflow/Workflow/List.hs

@@ -0,0 +1,28 @@
+module Handler.Workflow.Workflow.List
+  ( getGlobalWorkflowWorkflowListR 
+  , workflowWorkflowListR
+  , getGWIWorkflowsR 
+  , workflowInstanceWorkflowsR 
+  , getAdminWorkflowWorkflowListR
+  ) where
+
+import Import
+
+
+getGlobalWorkflowWorkflowListR :: Handler Html
+getGlobalWorkflowWorkflowListR = workflowWorkflowListR WSGlobal
+
+workflowWorkflowListR :: WorkflowScope TermId SchoolId CourseId -> Handler Html
+workflowWorkflowListR = error "not implemented"
+
+
+getGWIWorkflowsR :: WorkflowInstanceName -> Handler Html
+getGWIWorkflowsR win
+  = workflowInstanceWorkflowsR <=< runDB . getKeyBy404 $ UniqueWorkflowInstance win WSGlobal
+
+workflowInstanceWorkflowsR :: WorkflowInstanceId -> Handler Html
+workflowInstanceWorkflowsR = error "not implemented"
+
+
+getAdminWorkflowWorkflowListR :: Handler Html
+getAdminWorkflowWorkflowListR = error "not implemented"

src/Handler/Workflow/Workflow/New.hs

@@ -0,0 +1,10 @@
+module Handler.Workflow.Workflow.New
+  ( getAdminWorkflowWorkflowNewR, postAdminWorkflowWorkflowNewR
+  ) where
+
+import Import
+
+
+getAdminWorkflowWorkflowNewR, postAdminWorkflowWorkflowNewR :: Handler Html
+getAdminWorkflowWorkflowNewR = postAdminWorkflowWorkflowNewR
+postAdminWorkflowWorkflowNewR = error "not implemented"

src/Handler/Workflow/Workflow/Workflow.hs

@@ -0,0 +1,19 @@
+module Handler.Workflow.Workflow.Workflow
+  ( getGWWWorkflowR, postGWWWorkflowR
+  , workflowR
+  ) where
+
+import Import
+
+import Handler.Utils.Workflow.Workflow
+
+
+getGWWWorkflowR, postGWWWorkflowR :: CryptoFileNameWorkflowWorkflow -> Handler Html
+getGWWWorkflowR = postGWWWorkflowR
+postGWWWorkflowR cID = do
+  wId <- runDB . maybeT notFound $ ensureScope WSGlobal cID
+
+  workflowR wId
+
+workflowR :: WorkflowWorkflowId -> Handler Html
+workflowR = error "not implemented"

src/Model/Types/Security.hs

@@ -55,6 +55,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
   | AuthSystemExamOffice
   | AuthEvaluation
   | AuthAllocationAdmin
+  | AuthWorkflow
   | AuthAllocationRegistered
   | AuthCourseRegistered
   | AuthTutorialRegistered

src/Model/Types/Workflow.hs

@@ -3,8 +3,8 @@
 module Model.Types.Workflow
   ( WorkflowGraph(..)
   , WorkflowGraphNodeLabel
-  , WorkflowInstanceScope(..)
+  , WorkflowScope(..)
-  , WorkflowInstanceScope'(..)
+  , WorkflowScope'(..), classifyWorkflowScope
   , WorkflowState
   , WorkflowAction(..)
   , WorkflowChildren
@@ -48,13 +48,11 @@ data WorkflowGraph fileid userid = WorkflowGraph
 newtype WorkflowGraphNodeLabel = WorkflowGraphNodeLabel { unWorkflowGraphNodeLabel :: CI Text }
   deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable)
   deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PersistField, PersistFieldSql)
-newtype WorkflowGraphEdgeLabel = WorkflowGraphEdgeLabel { unWorkflowGraphEdgeLabel :: CI Text }
-  deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable)
-  deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PersistField, PersistFieldSql)
 
 data WorkflowGraphNode fileid userid = WGN
   { wgnDisplayLabel :: Maybe I18nText
-  , wgnInitial, wgnFinished :: Bool
+  , wgnInitial      :: Maybe (NonNull (Set (WorkflowRole userid)))
+  , wgnFinal        :: Bool
   , wgnViewers      :: Set (WorkflowRole userid)
   , wgnEdges        :: Map WorkflowGraphEdgeLabel (WorkflowGraphEdge fileid userid)
   }
@@ -63,6 +61,10 @@ data WorkflowGraphNode fileid userid = WGN
 
 -----  WORKFLOW GRAPH: EDGES  -----
 
+newtype WorkflowGraphEdgeLabel = WorkflowGraphEdgeLabel { unWorkflowGraphEdgeLabel :: CI Text }
+  deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable)
+  deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PersistField, PersistFieldSql)
+
 data WorkflowGraphEdge fileid userid
   = WorkflowGraphEdgeManual
     { wgeTarget    :: WorkflowGraphNodeLabel
@@ -122,7 +124,7 @@ data WorkflowPayloadField fileid userid (payload :: Type) where
   WorkflowPayloadFieldBool      :: { wpfbLabel       :: I18nText
                                    , wpfbTooltip     :: Maybe I18nHtml
                                    , wpfbDefault     :: Maybe Bool
-                                   , wpfbOptional    :: Maybe Text -- ^ Optional if `Just`; encodes label of `Nothing`-Option
+                                   , wpfbOptional    :: Maybe I18nText -- ^ Optional if `Just`; encodes label of `Nothing`-Option
                                    } -> WorkflowPayloadField fileid userid Bool
   WorkflowPayloadFieldFile      :: { wpffLabel       :: I18nText
                                    , wpffTooltip     :: Maybe I18nHtml
@@ -173,19 +175,26 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid) => Ord (Work
 
 -----  WORKFLOW INSTANCE  -----
 
-data WorkflowInstanceScope termid schoolid courseid
+data WorkflowScope termid schoolid courseid
-  = WISGlobal
+  = WSGlobal
-  | WISTerm   { wisTerm   :: termid   }
+  | WSTerm   { wisTerm   :: termid   }
-  | WISSchool { wisSchool :: schoolid }
+  | WSSchool { wisSchool :: schoolid }
-  | WISTermSchool { wisTerm   :: termid, wisSchool :: schoolid }
+  | WSTermSchool { wisTerm :: termid, wisSchool :: schoolid }
-  | WISCourse { wisCourse :: courseid }
+  | WSCourse { wisCourse :: courseid }
   deriving (Eq, Ord, Show, Read, Data, Generic, Typeable)
 
-data WorkflowInstanceScope'
+data WorkflowScope'
-  = WISGlobal' | WISTerm' | WISSchool' | WISTermSchool' | WISCourse'
+  = WSGlobal' | WSTerm' | WSSchool' | WSTermSchool' | WSCourse'
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Generic, Typeable)
   deriving anyclass (Universe, Finite)
 
+classifyWorkflowScope :: WorkflowScope termid schoolid courseid -> WorkflowScope'
+classifyWorkflowScope = \case
+  WSGlobal       -> WSGlobal'
+  WSTerm{}       -> WSTerm'
+  WSSchool{}     -> WSSchool'
+  WSTermSchool{} -> WSTermSchool'
+  WSCourse{}     -> WSCourse'
 
 -----  WORKFLOW: PAYLOAD  -----
 
@@ -252,9 +261,10 @@ data WorkflowFieldPayload'' = WFPText' | WFPNumber' | WFPBool' | WFPFile' | WFPU
 
 ----- PathPiece instances -----
 
-nullaryPathPiece ''WorkflowInstanceScope' $ camelToPathPiece' 1 . fromJust . stripSuffix "'"
+nullaryPathPiece ''WorkflowScope' $ camelToPathPiece' 1 . fromJust . stripSuffix "'"
 nullaryPathPiece ''WorkflowFieldPayload'' $ camelToPathPiece' 1 . fromJust . stripSuffix "'"
 
+derivePathPiece ''WorkflowScope (camelToPathPiece' 1) "--"
 
 ----- Generic traversal -----
 
@@ -482,9 +492,9 @@ instance ( FromJSON fileid, FromJSON userid
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 1
   , fieldLabelModifier = camelToPathPiece' 1
-  } ''WorkflowInstanceScope
+  } ''WorkflowScope
 
-pathPieceJSON ''WorkflowInstanceScope'
+pathPieceJSON ''WorkflowScope'
 
 deriveToJSON workflowActionAesonOptions ''WorkflowAction
 
@@ -556,15 +566,15 @@ instance (   ToJSON fileid,   ToJSON userid
 
 instance (   ToJSON termid,   ToJSON schoolid,   ToJSON courseid
          , FromJSON termid, FromJSON schoolid, FromJSON courseid
-         ) => PersistField (WorkflowInstanceScope termid schoolid courseid) where
+         ) => PersistField (WorkflowScope termid schoolid courseid) where
   toPersistValue   = toPersistValueJSON
   fromPersistValue = fromPersistValueJSON
 instance (   ToJSON termid,   ToJSON schoolid,   ToJSON courseid
          , FromJSON termid, FromJSON schoolid, FromJSON courseid
-         ) => PersistFieldSql (WorkflowInstanceScope termid schoolid courseid) where
+         ) => PersistFieldSql (WorkflowScope termid schoolid courseid) where
   sqlType _ = sqlTypeJSON
 
-derivePersistFieldJSON ''WorkflowInstanceScope'
+derivePersistFieldJSON ''WorkflowScope'
 
 instance (   ToJSON fileid,   ToJSON userid
          , FromJSON fileid, FromJSON userid
@@ -579,3 +589,9 @@ instance (   ToJSON fileid,   ToJSON userid
          , Typeable fileid, Typeable userid
          ) => PersistFieldSql (WorkflowState fileid userid) where
   sqlType _ = sqlTypeJSON
+
+
+-----  Binary instances  -----
+
+instance Binary WorkflowScope'
+instance (Binary termid, Binary schoolid, Binary courseid) => Binary (WorkflowScope termid schoolid courseid)

src/Utils/Form.hs

@@ -1110,6 +1110,12 @@ validateFormDB :: ( MonadHandler m
                -> (Markup -> MForm m (FormResult a, xml))
 validateFormDB (FormValidator valF) = validateForm . FormValidator $ hoist (liftHandler . runDB) valF
 
+validateAForm :: MonadHandler m
+              => FormValidator a m ()
+              -> AForm m a
+              -> AForm m a
+validateAForm valF form = formToAForm . over (mapped . _2) ($ []) $ validateForm valF (const $ aFormToForm form) mempty
+
 tellValidationError :: ( MonadHandler m
                        , RenderMessage (HandlerSite m) msg
                        )

src/Utils/Icon.hs

@@ -90,6 +90,7 @@ data Icon
   | IconAllocationRegister | IconAllocationRegistrationEdit
   | IconAllocationApplicationEdit
   | IconPersonalIdentification
+  | IconMenuWorkflows
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
 
 iconText :: Icon -> Text
@@ -160,6 +161,7 @@ iconText = \case
     IconAllocationRegistrationEdit -> "pencil-alt"
     IconAllocationApplicationEdit -> "pencil-alt"
     IconPersonalIdentification  -> "id-card"
+    IconMenuWorkflows           -> "folders"
 
 instance Universe Icon
 instance Finite   Icon

src/Utils/Lens.hs

@@ -247,6 +247,10 @@ makeLenses_ ''FallbackPersonalisedSheetFilesKey
 
 makeLenses_ ''WorkflowDefinition
 makeLenses_ ''WorkflowDefinitionDescription
+makeLenses_ ''WorkflowDefinitionInstanceDescription
+makeLenses_ ''WorkflowScope
+makeLenses_ ''WorkflowInstance
+makeLenses_ ''WorkflowInstanceDescription
 
 makeWrapped ''Textarea
 

templates/widgets/massinput/workflowDescriptions/layout.hamlet

@@ -3,13 +3,13 @@ $newline never
   <thead>
     <tr>
       <th>
-        _{MsgWorkflowDefinitionDescriptionLanguage} #
+        _{MsgWorkflowDescriptionLanguage} #
         <span .form-group__required-marker>
       <th>
-        _{MsgWorkflowDefinitionDescriptionTitle} #
+        _{MsgWorkflowDescriptionTitle} #
         <span .form-group__required-marker>
       <th>
-        _{MsgWorkflowDefinitionDescription}
+        _{MsgWorkflowDescription}
       <td>
   <tbody>
     $forall coord <- review liveCoords lLength