57 lines
2.0 KiB
Haskell
57 lines
2.0 KiB
Haskell
module Handler.Workflow.Definition.New
|
|
( getAdminWorkflowDefinitionNewR, postAdminWorkflowDefinitionNewR
|
|
) where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
import Handler.Workflow.Definition.Form
|
|
|
|
import Data.Map.Strict ((!))
|
|
|
|
|
|
getAdminWorkflowDefinitionNewR, postAdminWorkflowDefinitionNewR :: Handler Html
|
|
getAdminWorkflowDefinitionNewR = postAdminWorkflowDefinitionNewR
|
|
postAdminWorkflowDefinitionNewR = do
|
|
(((_, newForm), newEncoding), act) <- runDB $ do
|
|
form@((newRes, _), _) <- runFormPost $ workflowDefinitionForm Nothing
|
|
|
|
act <- formResultMaybe newRes $ \WorkflowDefinitionForm{..} -> do
|
|
wdfGraph' <- 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
|
|
}
|
|
|
|
for_ insRes $ \wdId -> iforM_ wdfDescriptions $ \wddLang (wddTitle, wddDesc) ->
|
|
insert WorkflowDefinitionDescription
|
|
{ workflowDefinitionDescriptionDefinition = wdId
|
|
, workflowDefinitionDescriptionLanguage = wddLang
|
|
, workflowDefinitionDescriptionTitle = wddTitle
|
|
, workflowDefinitionDescriptionDescription = 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
|