This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Utils/Workflow/Restriction.hs
2020-12-04 17:50:32 +01:00

30 lines
1.5 KiB
Haskell

module Handler.Utils.Workflow.Restriction
( checkWorkflowRestriction
) where
import Import
import Utils.Workflow
import qualified Data.Set as Set
import qualified Data.Map as Map
checkWorkflowRestriction :: Maybe IdWorkflowState
-> PredDNF WorkflowGraphRestriction
-> Bool
checkWorkflowRestriction mHistory dnf = maybe False (ofoldr1 (||)) . fromNullable $ map evalConj dnf'
where
evalConj = maybe True (ofoldr1 (&&)) . fromNullable . map evalPred
evalPred PLVariable{ plVar = WorkflowGraphRestrictionPayloadFilled{..} } = wgrPayloadFilled `Set.member` filledPayloads
evalPred PLNegated{ plVar = WorkflowGraphRestrictionPayloadFilled{..} } = wgrPayloadFilled `Set.notMember` filledPayloads
evalPred PLVariable{ plVar = WorkflowGraphRestrictionPreviousNode{..} } = maybe False (wgrPreviousNode ==) cState
evalPred PLNegated{ plVar = WorkflowGraphRestrictionPreviousNode{..} } = maybe True (wgrPreviousNode /=) cState
evalPred PLVariable{ plVar = WorkflowGraphRestrictionInitial } = is _Nothing mHistory
evalPred PLNegated{ plVar = WorkflowGraphRestrictionInitial } = isn't _Nothing mHistory
dnf' = map (Set.toList . toNullable) . Set.toList $ dnfTerms dnf
filledPayloads | Just history <- mHistory = Map.keysSet . Map.filter (not . Set.null) $ workflowStateCurrentPayloads history
| otherwise = Set.empty
cState = wpTo . last <$> mHistory