63 lines
2.3 KiB
Haskell
63 lines
2.3 KiB
Haskell
module Handler.Workflow.Definition.New
|
|
( getAdminWorkflowDefinitionNewR, postAdminWorkflowDefinitionNewR
|
|
) where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
import Handler.Workflow.Definition.Form
|
|
import Utils.Workflow
|
|
|
|
|
|
getAdminWorkflowDefinitionNewR, postAdminWorkflowDefinitionNewR :: Handler Html
|
|
getAdminWorkflowDefinitionNewR = postAdminWorkflowDefinitionNewR
|
|
postAdminWorkflowDefinitionNewR = do
|
|
(((_, newForm), newEncoding), act) <- runDB $ do
|
|
form@((newRes, _), _) <- runFormPost $ workflowDefinitionForm Nothing
|
|
|
|
act <- formResultMaybe newRes $ \WorkflowDefinitionForm{ .. } -> do
|
|
wdfGraph' <- fromWorkflowGraphForm wdfGraph
|
|
workflowDefinitionGraph <- insertSharedWorkflowGraph wdfGraph'
|
|
|
|
insRes <- insertUnique WorkflowDefinition
|
|
{ workflowDefinitionGraph
|
|
, workflowDefinitionScope = wdfScope
|
|
, workflowDefinitionName = wdfName
|
|
, workflowDefinitionInstanceCategory = wdfInstanceCategory
|
|
}
|
|
|
|
for_ insRes $ \wdId -> iforM_ wdfDescriptions $ \wddLang (wddTitle, wddDesc) ->
|
|
insert WorkflowDefinitionDescription
|
|
{ workflowDefinitionDescriptionDefinition = wdId
|
|
, workflowDefinitionDescriptionLanguage = wddLang
|
|
, 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
|
|
addMessageI Success MsgWorkflowDefinitionCreated
|
|
redirect AdminWorkflowDefinitionListR
|
|
Nothing -> return . Just $
|
|
addMessageI Error MsgWorkflowDefinitionCollision
|
|
|
|
return (form, act)
|
|
|
|
forM_ act id
|
|
|
|
let newWidget = wrapForm newForm def
|
|
{ formAction = Just $ SomeRoute AdminWorkflowDefinitionNewR
|
|
, formEncoding = newEncoding
|
|
}
|
|
|
|
siteLayoutMsg MsgWorkflowDefinitionNewTitle $ do
|
|
setTitleI MsgWorkflowDefinitionNewTitle
|
|
|
|
newWidget
|