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