99 lines
3.9 KiB
Haskell
99 lines
3.9 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
|
|
module Handler.Workflow.Definition.Edit
|
|
( getAWDEditR, postAWDEditR
|
|
) where
|
|
|
|
import Import
|
|
import Utils.Workflow
|
|
import Handler.Utils
|
|
import Handler.Workflow.Definition.Form
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
|
|
getAWDEditR, postAWDEditR :: WorkflowScope' -> WorkflowDefinitionName -> Handler Html
|
|
getAWDEditR = postAWDEditR
|
|
postAWDEditR wds' wdn = do
|
|
(((_, editForm), editEncoding), act) <- runDB $ do
|
|
Entity wdId WorkflowDefinition{..} <- getBy404 $ UniqueWorkflowDefinition wdn wds'
|
|
template <- do
|
|
descs <- selectList [WorkflowDefinitionDescriptionDefinition ==. wdId] []
|
|
let wdfDescriptions = Map.fromList
|
|
[ (workflowDefinitionDescriptionLanguage, (workflowDefinitionDescriptionTitle, workflowDefinitionDescriptionDescription))
|
|
| Entity _ WorkflowDefinitionDescription{..} <- descs
|
|
]
|
|
|
|
iDescs <- selectList [WorkflowDefinitionInstanceDescriptionDefinition ==. wdId] []
|
|
let wdfInstanceDescriptions = Map.fromList
|
|
[ (workflowDefinitionInstanceDescriptionLanguage, (workflowDefinitionInstanceDescriptionTitle, workflowDefinitionInstanceDescriptionDescription))
|
|
| Entity _ WorkflowDefinitionInstanceDescription{..} <- iDescs
|
|
]
|
|
|
|
wdfGraph <- toWorkflowGraphForm =<< getSharedDBWorkflowGraph workflowDefinitionGraph
|
|
|
|
return WorkflowDefinitionForm
|
|
{ wdfScope = workflowDefinitionScope
|
|
, wdfName = workflowDefinitionName
|
|
, wdfInstanceCategory = workflowDefinitionInstanceCategory
|
|
, wdfDescriptions
|
|
, wdfInstanceDescriptions
|
|
, wdfGraph
|
|
}
|
|
|
|
form@((editRes, _), _) <- runFormPost . workflowDefinitionForm $ Just template
|
|
|
|
act <- formResultMaybe editRes $ \WorkflowDefinitionForm{..} -> do
|
|
wdfGraph' <- fromWorkflowGraphForm wdfGraph
|
|
wdfGraph'' <- insertSharedWorkflowGraph wdfGraph'
|
|
|
|
insConflict <- replaceUnique wdId WorkflowDefinition
|
|
{ workflowDefinitionGraph = wdfGraph''
|
|
, workflowDefinitionScope = wdfScope
|
|
, workflowDefinitionName = wdfName
|
|
, workflowDefinitionInstanceCategory = wdfInstanceCategory
|
|
}
|
|
|
|
when (is _Nothing insConflict) . iforM_ wdfDescriptions $ \wddLang (wddTitle, wddDesc) -> do
|
|
deleteWhere [WorkflowDefinitionDescriptionDefinition ==. wdId]
|
|
insert WorkflowDefinitionDescription
|
|
{ workflowDefinitionDescriptionDefinition = wdId
|
|
, workflowDefinitionDescriptionLanguage = wddLang
|
|
, 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 $
|
|
addMessage' =<< messageIHamlet Error
|
|
[ihamlet|
|
|
$newline never
|
|
<a href=@{AdminWorkflowDefinitionR wds'' wdn' AWDEditR}>
|
|
_{MsgWorkflowDefinitionCollision}
|
|
|]
|
|
Nothing -> return . Just $ do
|
|
addMessageI Success MsgWorkflowDefinitionEdited
|
|
redirect AdminWorkflowDefinitionListR
|
|
|
|
return (form, act)
|
|
|
|
forM_ act id
|
|
|
|
let editWidget = wrapForm editForm def
|
|
{ formAction = Just . SomeRoute $ AdminWorkflowDefinitionR wds' wdn AWDEditR
|
|
, formEncoding = editEncoding
|
|
}
|
|
|
|
siteLayoutMsg MsgWorkflowDefinitionEditTitle $ do
|
|
setTitleI MsgWorkflowDefinitionEditTitle
|
|
|
|
editWidget
|