module Handler.Workflow.Instance.Update
  ( WorkflowInstanceUpdateButton(..)
  , workflowInstanceCanUpdate
  , postGWIUpdateR, postSWIUpdateR
  ) where

import Import
import Utils.Form
import Utils.Workflow

import Handler.Utils.Workflow.CanonicalRoute

import qualified Data.CaseInsensitive as CI

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

import Handler.Utils.Memcached


data WorkflowInstanceUpdateButton
  = BtnWorkflowInstanceUpdate
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''WorkflowInstanceUpdateButton $ camelToPathPiece' 3
embedRenderMessage ''UniWorX ''WorkflowInstanceUpdateButton id

instance Button UniWorX WorkflowInstanceUpdateButton where
  btnClasses _ = [BCIsButton]


data WorkflowInstanceUpdateAction
  = WIUpdateGraph SharedWorkflowGraphId
  | WIUpdateCategory (Maybe WorkflowInstanceCategory)
  | WIUpdateInstanceDescription Lang (Maybe (Text, Maybe StoredMarkup))
  deriving (Eq, Ord, Read, Show, Generic, Typeable)


workflowInstanceUpdates :: WorkflowInstanceId
                        -> DB (Set WorkflowInstanceUpdateAction)
workflowInstanceUpdates wiId = execWriterT . maybeT_ $ do
  WorkflowInstance{..} <- MaybeT . lift $ get wiId
  wdId <- hoistMaybe workflowInstanceDefinition
  WorkflowDefinition{..} <- MaybeT . lift $ get wdId

  when (workflowDefinitionGraph /= workflowInstanceGraph) $
    tellPoint $ WIUpdateGraph workflowDefinitionGraph

  when (workflowDefinitionInstanceCategory /= workflowInstanceCategory) $
    tellPoint $ WIUpdateCategory workflowDefinitionInstanceCategory

  iDescs <- lift . lift $ selectList [WorkflowInstanceDescriptionInstance ==. wiId] []
  dDescs <- lift . lift $ selectList [WorkflowDefinitionInstanceDescriptionDefinition ==. wdId] []

  let iDescs' = Map.fromList $ map (\(Entity _ WorkflowInstanceDescription{..}) -> (CI.mk workflowInstanceDescriptionLanguage, (workflowInstanceDescriptionTitle, workflowInstanceDescriptionDescription))) iDescs
      dDescs' = Map.fromList $ map (\(Entity _ WorkflowDefinitionInstanceDescription{..}) -> (CI.mk workflowDefinitionInstanceDescriptionLanguage, (workflowDefinitionInstanceDescriptionTitle, workflowDefinitionInstanceDescriptionDescription))) dDescs

  forM_ (Map.keysSet iDescs' `Set.union` Map.keysSet dDescs') $ \lang -> if
    | Just iDesc <- Map.lookup lang iDescs'
    , Just dDesc <- Map.lookup lang dDescs'
    , iDesc /= dDesc
      -> tellPoint . WIUpdateInstanceDescription (CI.original lang) $ Just dDesc
    | Just dDesc <- Map.lookup lang dDescs'
    , not $ Map.member lang iDescs'
      -> tellPoint . WIUpdateInstanceDescription (CI.original lang) $ Just dDesc
    | Map.member lang iDescs'
    , not $ Map.member lang dDescs'
      -> tellPoint $ WIUpdateInstanceDescription (CI.original lang) Nothing
    | otherwise
      -> return ()

workflowInstanceCanUpdate :: WorkflowInstanceId
                          -> DB Bool
workflowInstanceCanUpdate wiId = not . null <$> workflowInstanceUpdates wiId


postGWIUpdateR :: WorkflowInstanceName -> Handler Void
postGWIUpdateR = updateR WSGlobal

postSWIUpdateR :: SchoolId -> WorkflowInstanceName -> Handler Void
postSWIUpdateR ssh = updateR $ WSSchool ssh


updateR :: RouteWorkflowScope -> WorkflowInstanceName -> Handler a
updateR rScope win = do
  runDB $ do
    scope <- maybeT notFound $ fromRouteWorkflowScope rScope
    wiId <- getKeyBy404 . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope 
    updates <- workflowInstanceUpdates wiId

    when (null updates) $
      addMessageI Warning MsgWorkflowInstanceUpdateNoActions

    forM_ updates $ \case
      WIUpdateGraph graphId -> do
        update wiId [ WorkflowInstanceGraph =. graphId ]
        addMessageI Success MsgWorkflowInstanceUpdateUpdatedGraph
      WIUpdateCategory iCat -> do
        update wiId [ WorkflowInstanceCategory =. iCat ]
        addMessageI Success MsgWorkflowInstanceUpdateUpdatedCategory
      WIUpdateInstanceDescription lang Nothing -> do
        deleteBy $ UniqueWorkflowInstanceDescription wiId lang
        addMessageI Success $ MsgWorkflowInstanceUpdateDeletedDescriptionLanguage lang
      WIUpdateInstanceDescription lang (Just (title, mDesc)) -> do
        void $ upsertBy
          (UniqueWorkflowInstanceDescription wiId lang) 
          WorkflowInstanceDescription
            { workflowInstanceDescriptionInstance = wiId
            , workflowInstanceDescriptionLanguage = lang
            , workflowInstanceDescriptionTitle = title
            , workflowInstanceDescriptionDescription = mDesc
            }
          [ WorkflowInstanceDescriptionTitle =. title
          , WorkflowInstanceDescriptionDescription =. mDesc
          ]
        addMessageI Success $ MsgWorkflowInstanceUpdateUpdatedDescriptionLanguage lang
    memcachedByInvalidate (AuthCacheWorkflowInstanceInitiators win rScope) $ Proxy @(Set (WorkflowRole UserId))
    memcachedByInvalidate (AuthCacheWorkflowInstanceWorkflowViewers win rScope) $ Proxy @(WorkflowWorkflowId, Set (WorkflowRole UserId))
    when (isTopWorkflowScope rScope) $
      memcachedByInvalidate NavCacheHaveTopWorkflowInstancesRoles $ Proxy @(Set ((RouteWorkflowScope, WorkflowInstanceName), WorkflowRole UserId))
        
  redirect $ _WorkflowScopeRoute # ( rScope, WorkflowInstanceListR )