module Handler.Workflow.Instance.Initiate
  ( getGWIInitiateR, postGWIInitiateR 
  , getSWIInitiateR, postSWIInitiateR 
  , workflowInstanceInitiateR
  ) where

import Import

import Utils.Form
import Utils.Workflow

import Handler.Utils
import Handler.Utils.Workflow

import qualified Data.CaseInsensitive as CI
import qualified Data.List.NonEmpty as NonEmpty


getGWIInitiateR, postGWIInitiateR :: WorkflowInstanceName -> Handler Html
getGWIInitiateR = postGWIInitiateR
postGWIInitiateR = workflowInstanceInitiateR WSGlobal

getSWIInitiateR, postSWIInitiateR :: SchoolId -> WorkflowInstanceName -> Handler Html
getSWIInitiateR = postSWIInitiateR
postSWIInitiateR ssh = workflowInstanceInitiateR $ WSSchool ssh

workflowInstanceInitiateR :: RouteWorkflowScope -> WorkflowInstanceName -> Handler Html
workflowInstanceInitiateR rScope win = workflowsDisabledWarning MsgWorkflowInstanceInitiateTitleDisabled MsgWorkflowInstanceInitiateHeadingDisabled $ do
  (WorkflowInstance{..}, ((edgeAct, edgeView'), edgeEnc), mDesc) <- runDB $ do
    scope <- maybeT notFound $ fromRouteWorkflowScope rScope
    Entity wiId wi@WorkflowInstance{..} <- getBy404 . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope 
    edgeForm <- maybeT notFound . MaybeT $ workflowEdgeForm (Left wiId) Nothing

    descs <- selectList [ WorkflowInstanceDescriptionInstance ==. wiId ] []
    mDesc <- runMaybeT $ do
      langs <- hoistMaybe . nonEmpty $ map (workflowInstanceDescriptionLanguage . entityVal) descs
      lang <- selectLanguage langs
      hoistMaybe . preview _head $ do
        Entity _ desc@WorkflowInstanceDescription{..} <- descs
        guard $ workflowInstanceDescriptionLanguage == lang
        return desc

    ((edgeRes, edgeView), edgeEnc) <- liftHandler . runFormPost $ renderAForm FormStandard edgeForm

    edgeAct <- formResultMaybe edgeRes $ \edgeRes' -> do
      wGraph <- getSharedIdWorkflowGraph workflowInstanceGraph
      workflowWorkflowState <- view _DBWorkflowState <$> followEdge wGraph edgeRes' Nothing
      
      wwId <- insert WorkflowWorkflow
        { workflowWorkflowInstance = Just wiId
        , workflowWorkflowScope    = workflowInstanceScope
        , workflowWorkflowGraph    = workflowInstanceGraph
        , workflowWorkflowState
        , workflowWorkflowArchived = Nothing  -- FIXME: set to now + 2 months if current state is final state
        }

      return . Just $ do
        memcachedByInvalidate (AuthCacheWorkflowInstanceWorkflowViewers win rScope) $ Proxy @(Set ((DBWorkflowScope, WorkflowWorkflowId), WorkflowRole UserId))
        memcachedByInvalidate (NavCacheHaveWorkflowWorkflowsRoles rScope) $ Proxy @(Set ((WorkflowWorkflowId, CryptoFileNameWorkflowWorkflow), WorkflowRole UserId))
        when (isTopWorkflowScope rScope) $
          memcachedByInvalidate NavCacheHaveTopWorkflowWorkflowsRoles $ Proxy @(Set ((WorkflowWorkflowId, CryptoFileNameWorkflowWorkflow, RouteWorkflowScope), WorkflowRole UserId))

        
        addMessageI Success MsgWorkflowInstanceInitiateSuccess

        cID <- encrypt wwId
        redirectAlternatives $ NonEmpty.fromList
          [ _WorkflowScopeRoute # ( rScope, WorkflowWorkflowR cID WWWorkflowR )
          , _WorkflowScopeRoute # ( rScope, WorkflowInstanceR workflowInstanceName WIWorkflowsR )
          , _WorkflowScopeRoute # ( rScope, WorkflowInstanceListR )
          ]

    return (wi, ((edgeAct, edgeView), edgeEnc), mDesc)

  sequence_ edgeAct

  (heading, title) <- case rScope of
    WSGlobal -> return (MsgGlobalWorkflowInstanceInitiateHeading $ maybe (CI.original workflowInstanceName) workflowInstanceDescriptionTitle mDesc, MsgGlobalWorkflowInstanceInitiateTitle)
    WSSchool ssh -> return (MsgSchoolWorkflowInstanceInitiateHeading ssh $ maybe (CI.original workflowInstanceName) workflowInstanceDescriptionTitle mDesc, MsgSchoolWorkflowInstanceInitiateTitle ssh)
    _other -> error "not implemented"

  siteLayoutMsg heading $ do
    setTitleI title
    let edgeView = wrapForm edgeView' FormSettings
          { formMethod = POST
          , formAction = Just . SomeRoute $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
          , formEncoding = edgeEnc
          , formAttrs = []
          , formSubmit = FormSubmit
          , formAnchor = Nothing :: Maybe Text
          }
    $(widgetFile "workflows/instance-initiate")