81 lines
3.6 KiB
Haskell
81 lines
3.6 KiB
Haskell
module Handler.Workflow.Instance.Form
|
|
( WorkflowInstanceForm(..), FileIdent
|
|
, workflowInstanceForm
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
|
|
import Handler.Utils.Workflow.Form
|
|
import Utils.Workflow
|
|
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Set as Set
|
|
|
|
|
|
workflowInstanceScopeForm :: Maybe WorkflowScope'
|
|
-> FieldSettings UniWorX
|
|
-> Maybe IdWorkflowScope
|
|
-> AForm Handler IdWorkflowScope
|
|
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 MsgTableSchool) (mPrev ^? _Just . _wisSchool)
|
|
)
|
|
, ( WSTermSchool'
|
|
, WSTermSchool <$> apopt termField (fslI MsgTerm) (mPrev ^? _Just . _wisTerm)
|
|
<*> apopt schoolField (fslI MsgTableSchool) (mPrev ^? _Just . _wisSchool)
|
|
)
|
|
, ( WSCourse'
|
|
, WSCourse <$> apopt (selectField' Nothing courseOptions) (fslI MsgTableCourse) (mPrev ^? _Just . _wisCourse)
|
|
)
|
|
]
|
|
where courseOptions = fmap (fmap entityKey) . optionsPersistCryptoId [] [ Desc CourseTerm, Asc CourseSchool, Asc CourseName ] $ \Course{..} -> MsgCourseOption courseTerm courseSchool courseName
|
|
|
|
|
|
data WorkflowInstanceForm = WorkflowInstanceForm
|
|
{ wifScope :: IdWorkflowScope
|
|
, wifName :: WorkflowInstanceName
|
|
, wifCategory :: Maybe WorkflowInstanceCategory
|
|
, wifDescriptions :: Map Lang (Text, Maybe StoredMarkup)
|
|
, 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 <=< lift . lift . getSharedDBWorkflowGraph . 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
|