module Handler.Utils.Workflow.Workflow
  ( ensureScope
  , followEdge
  , followAutomaticEdges, WorkflowAutomaticEdgeException(..)
  , checkWorkflowRestriction
  ) where

import Import

import Handler.Utils.Workflow.EdgeForm

import qualified Data.Set as Set
import qualified Data.Map as Map


ensureScope :: WorkflowScope TermId SchoolId CourseId -> CryptoFileNameWorkflowWorkflow -> MaybeT DB WorkflowWorkflowId
ensureScope wiScope cID = do
  wId <- catchMaybeT (Proxy @CryptoIDError) $ decrypt cID
  WorkflowWorkflow{..} <- MaybeT $ get wId
  let wiScope' = wiScope
        & _wisTerm   %~ unTermKey
        & _wisSchool %~ unSchoolKey
        & _wisCourse %~ view _SqlKey
  guard $ workflowWorkflowScope == wiScope'
  return wId

followEdge :: ( MonadHandler m
              , HandlerSite m ~ UniWorX
              , MonadThrow m
              )
           => WorkflowGraph FileReference UserId -> WorkflowEdgeForm -> Maybe (WorkflowState FileReference UserId) -> m (WorkflowState FileReference UserId)
followEdge graph edgeRes cState = do
  act <- workflowEdgeFormToAction edgeRes
  followAutomaticEdges graph $ maybe id (<>) cState (act `ncons` mempty)

data WorkflowAutomaticEdgeException
  = WorkflowAutomaticEdgeCycle [(WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel)]
  | WorkflowAutomaticEdgeAmbiguity (Set (WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel))
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Exception)

followAutomaticEdges :: forall m.
                        ( MonadIO m
                        , MonadThrow m
                        )
                     => WorkflowGraph FileReference UserId
                     -> WorkflowState FileReference UserId -> m (WorkflowState FileReference UserId)
followAutomaticEdges WorkflowGraph{..} = go []
  where
    go :: [((WorkflowGraphNodeLabel, Set WorkflowPayloadLabel), (WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel))] -- ^ Should encode all state from which automatic edges decide whether they can be followed
       -> WorkflowState FileReference UserId
       -> m (WorkflowState FileReference UserId)
    go automaticEdgesTaken history
      | null automaticEdgeOptions = return history
      | [(edgeLbl, nodeLbl)] <- automaticEdgeOptions = if
          | (edgeDecisionInput, (edgeLbl, nodeLbl)) `elem` automaticEdgesTaken
            -> throwM . WorkflowAutomaticEdgeCycle . reverse $ map (view _2) automaticEdgesTaken
          | otherwise -> do
              wpTime <- liftIO getCurrentTime
              let wpUser = Nothing
                  wpPayload = mempty
                  wpTo = nodeLbl
                  wpVia = edgeLbl
              go ((edgeDecisionInput, (edgeLbl, nodeLbl)) : automaticEdgesTaken) $ history <> (WorkflowAction{..} `ncons` mempty)
      | otherwise = throwM . WorkflowAutomaticEdgeAmbiguity $ Set.fromList automaticEdgeOptions
      where
        cState = wpTo $ last history
        automaticEdgeOptions = nub $ do
          (nodeLbl, WGN{..}) <- Map.toList wgNodes
          (edgeLbl, WorkflowGraphEdgeAutomatic{..}) <- Map.toList wgnEdges
          guard $ wgeSource == cState
          whenIsJust wgeRestriction $ guard . checkWorkflowRestriction history
          return (edgeLbl, nodeLbl)
        filledPayloads = Map.keysSet . Map.filter (not . Set.null) $ workflowStateCurrentPayloads history
        edgeDecisionInput = (cState, filledPayloads)

checkWorkflowRestriction :: WorkflowState FileReference UserId 
                         -> PredDNF WorkflowGraphRestriction
                         -> Bool
checkWorkflowRestriction history 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{..}  } = wgrPreviousNode == cState
    evalPred PLNegated{  plVar = WorkflowGraphRestrictionPreviousNode{..}  } = wgrPreviousNode /= cState
    dnf' = map (Set.toList . toNullable) . Set.toList $ dnfTerms dnf

    filledPayloads = Map.keysSet . Map.filter (not . Set.null) $ workflowStateCurrentPayloads history
    cState = wpTo $ last history