{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Handler.Workflow.Instance.List
  ( getAdminWorkflowInstanceListR
  , getGlobalWorkflowInstanceListR
  , getSchoolWorkflowInstanceListR
  , workflowInstanceListR
  , getTopWorkflowInstanceListR
  ) where

import Import
  
import Handler.Utils
import Utils.Workflow
import Handler.Utils.Workflow
import Handler.Workflow.Instance.Update

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E

import qualified Data.CaseInsensitive as CI

import qualified Data.List.NonEmpty as NonEmpty

import qualified Data.Map as Map


type WorkflowInstanceTableExpr = E.SqlExpr (Entity WorkflowInstance)

queryWorkflowInstance :: Equality' WorkflowInstanceTableExpr (E.SqlExpr (Entity WorkflowInstance))
queryWorkflowInstance = id

queryWorkflowCount :: Getter WorkflowInstanceTableExpr (E.SqlExpr (E.Value Int64))
queryWorkflowCount = to $ \(view queryWorkflowInstance -> workflowInstance) ->
  E.subSelectCount . E.from $ \workflow ->
    E.where_ $ workflow E.^. WorkflowWorkflowInstance E.==. E.just (workflowInstance E.^. WorkflowInstanceId)


type WorkflowInstanceData = DBRow
  ( Entity WorkflowInstance
  , Maybe (Entity WorkflowInstanceDescription)
  , Int64
  )

resultWorkflowInstance :: Lens' WorkflowInstanceData (Entity WorkflowInstance)
resultWorkflowInstance = _dbrOutput . _1

resultDescription :: Traversal' WorkflowInstanceData (Entity WorkflowInstanceDescription)
resultDescription = _dbrOutput . _2 . _Just

resultWorkflowCount :: Lens' WorkflowInstanceData Int64
resultWorkflowCount = _dbrOutput . _3
  

getAdminWorkflowInstanceListR :: Handler Html
getAdminWorkflowInstanceListR = do
  instancesTable <- runDB $ do
    scopeOptions <- do
      scopes <- fmap (map $ review _DBWorkflowScope . E.unValue) . E.select . E.from $ \workflowInstance ->
        return $ workflowInstance E.^. WorkflowInstanceScope
      fmap mkOptionList . for scopes $ \scope -> do
        eScope <- traverseOf _wisCourse encrypt scope :: DB CryptoIDWorkflowScope
        wScope <- maybeT notFound $ toRouteWorkflowScope scope
        MsgRenderer mr <- getMsgRenderer
        return Option
          { optionDisplay = mr wScope
          , optionInternalValue = scope
          , optionExternalValue = toPathPiece eScope
          }
    
    let workflowInstancesDBTable = DBTable{..}
          where
            dbtSQLQuery = runReaderT $ do
              workflowInstance <- view queryWorkflowInstance
              workflowCount <- view queryWorkflowCount
          
              return (workflowInstance, workflowCount)
            dbtRowKey = (E.^. WorkflowInstanceId)
            dbtProj = dbtProjFilteredPostSimple $ \(wi@(Entity wiId _), E.Value iCount) ->
              (wi, , iCount) <$> selectWorkflowInstanceDescription wiId
            dbtColonnade :: Colonnade Sortable WorkflowInstanceData _
            dbtColonnade = mconcat
              [ sortable (Just "name") (i18nCell MsgWorkflowInstanceName) . anchorEdit $ views (resultWorkflowInstance . _entityVal . _workflowInstanceName) i18n
              , sortable (Just "scope") (i18nCell MsgWorkflowScope) . views (resultWorkflowInstance . _entityVal . _workflowInstanceScope . re _DBWorkflowScope) $
                  sqlCell . maybeT (return mempty) . fmap i18n . toRouteWorkflowScope
              , sortable (Just "title") (i18nCell MsgWorkflowInstanceDescriptionTitle) $ maybe mempty i18nCell . preview (resultDescription . _entityVal . _workflowInstanceDescriptionTitle)
              , sortable (Just "workflows") (i18nCell MsgWorkflowInstanceWorkflowCount) $ maybe mempty i18nCell . views resultWorkflowCount (assertM' (> 0))
              , sortable (Just "description") (i18nCell MsgWorkflowInstanceDescription) $ maybe mempty modalCell . preview (resultDescription . _entityVal . _workflowInstanceDescriptionDescription . _Just)
              ]
              where
                anchorEdit :: (WorkflowInstanceData -> Widget) -> _
                anchorEdit f x@(view $ resultWorkflowInstance . _entityKey -> wiId) = anchorCellM mkLink $ f x
                  where mkLink = do
                          cID <- encrypt wiId
                          return $ AdminWorkflowInstanceR cID AWIEditR
            dbtSorting = mconcat
              [ singletonMap "name" . SortColumn $ views queryWorkflowInstance (E.^. WorkflowInstanceName)
              , singletonMap "scope" . SortColumn $ views queryWorkflowInstance (E.^. WorkflowInstanceScope)
              , singletonMap "title" . SortProjected . comparing . view $ resultDescription . _entityVal . _workflowInstanceDescriptionTitle
              , singletonMap "description" . SortProjected . comparing . view $ resultDescription . _entityVal . _workflowInstanceDescriptionDescription
              , singletonMap "workflows" . SortColumn $ view queryWorkflowCount
              ]
            dbtFilter = mconcat
              [ singletonMap "name" . FilterColumn $ E.mkContainsFilter (E.^. WorkflowInstanceName)
              , singletonMap "scope" . FilterColumn $ E.mkExactFilter (E.^. WorkflowInstanceScope)
              , singletonMap "title" . mkFilterProjectedPost $ \(ts :: Set Text) (view $ resultDescription . _entityVal . _workflowInstanceDescriptionTitle -> t) -> oany ((flip isInfixOf `on` CI.foldCase) t) ts
              ]
            dbtFilterUI mPrev = mconcat
              [ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgWorkflowInstanceName)
              , prismAForm (singletonFilter "scope" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return scopeOptions) (fslI MsgWorkflowScope)
              , prismAForm (singletonFilter "title") mPrev $ aopt textField (fslI MsgWorkflowInstanceDescriptionTitle)
              ]
            dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
            dbtParams = def
            dbtIdent :: Text
            dbtIdent = "workflow-instances"
            dbtCsvEncode = noCsvEncode
            dbtCsvDecode = Nothing
            dbtExtraReps = []
        workflowInstancesDBTableValidator = def
          & defaultSorting [SortAscBy "scope", SortAscBy "name"]
     in dbTableDB' workflowInstancesDBTableValidator workflowInstancesDBTable

  siteLayoutMsg MsgWorkflowInstanceListTitle $ do
    setTitleI MsgWorkflowInstanceListTitle

    instancesTable

  
getGlobalWorkflowInstanceListR :: Handler Html
getGlobalWorkflowInstanceListR = workflowInstanceListR WSGlobal
  
getSchoolWorkflowInstanceListR :: SchoolId -> Handler Html
getSchoolWorkflowInstanceListR = workflowInstanceListR . WSSchool


workflowInstanceListR :: RouteWorkflowScope -> Handler Html
workflowInstanceListR rScope = workflowsDisabledWarning title heading $ do
  instances <- runDB $ do
    dbScope <- maybeT notFound $ view _DBWorkflowScope <$> fromRouteWorkflowScope rScope
    
    wis <- selectList [ WorkflowInstanceScope ==. dbScope ] []
    wis' <- fmap catMaybes . forM wis $ \wi@(Entity wiId WorkflowInstance{..}) -> runMaybeT $ do
      descs <- lift $ selectList [ WorkflowInstanceDescriptionInstance ==. wiId ] []
      desc <- lift . runMaybeT $ do
        langs <- hoistMaybe . NonEmpty.nonEmpty $ map (workflowInstanceDescriptionLanguage . entityVal) descs
        lang <- selectLanguage langs
        hoistMaybe . preview _head $ do
          Entity _ desc@WorkflowInstanceDescription{..} <- descs
          guard $ workflowInstanceDescriptionLanguage == lang
          return desc
      mayInitiate <- lift . hasWriteAccessTo $ toInitiateRoute workflowInstanceName
      mayEdit <- lift . hasReadAccessTo $ toEditRoute workflowInstanceName
      mayList <- lift . hasReadAccessTo $ toListRoute workflowInstanceName
      mayUpdate <- lift  . hasWriteAccessTo $ toUpdateRoute workflowInstanceName
      guard $ mayInitiate || mayEdit || mayList || mayUpdate
      canUpdate <- lift $ workflowInstanceCanUpdate wiId
      return (wi, desc, canUpdate)

    return . flip sortOn wis' $ \(Entity _ WorkflowInstance{..}, mDesc, _)
      -> ( NTop workflowInstanceCategory
         , workflowInstanceDescriptionTitle <$> mDesc
         , workflowInstanceName
         )

  siteLayoutMsg heading $ do
    setTitleI title
    let mPitch = Just $(i18nWidgetFile "workflow-instance-list-explanation")
        updateForm win = maybeT mempty . guardMOnM (lift . hasWriteAccessTo $ toUpdateRoute win) $ do
          (updateWdgt, updateEnctype) <- liftHandler . generateFormPost . buttonForm' $ pure BtnWorkflowInstanceUpdate
          lift $ wrapForm updateWdgt def
            { formAction = Just . SomeRoute $ toUpdateRoute win
            , formEncoding = updateEnctype
            , formSubmit = FormNoSubmit
            }
    $(widgetFile "workflows/instances")
  where
    toInitiateRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIInitiateR)
    toEditRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIEditR)
    toListRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIWorkflowsR)
    toUpdateRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIUpdateR)

    (heading, title) = case rScope of
      WSGlobal -> (MsgGlobalWorkflowInstancesHeading, MsgGlobalWorkflowInstancesTitle)
      WSSchool ssh -> (MsgSchoolWorkflowInstancesHeading ssh, MsgSchoolWorkflowInstancesTitle ssh)
      _other -> error "not implemented"


getTopWorkflowInstanceListR :: Handler Html
getTopWorkflowInstanceListR = workflowsDisabledWarning title heading $ do
  gInstances <- runDB $ do
    wis <- selectList [] []
    wis' <- fmap catMaybes . forM wis $ \wi@(Entity wiId WorkflowInstance{..}) -> runMaybeT $ do
      guard $ isTopWorkflowScope workflowInstanceScope
      rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope
      descs <- lift $ selectList [ WorkflowInstanceDescriptionInstance ==. wiId ] []
      desc <- lift . runMaybeT $ do
        langs <- hoistMaybe . NonEmpty.nonEmpty $ map (workflowInstanceDescriptionLanguage . entityVal) descs
        lang <- selectLanguage langs
        hoistMaybe . preview _head $ do
          Entity _ desc@WorkflowInstanceDescription{..} <- descs
          guard $ workflowInstanceDescriptionLanguage == lang
          return desc
      mayInitiate <- lift . hasWriteAccessTo $ toInitiateRoute' rScope workflowInstanceName
      mayEdit <- lift . hasReadAccessTo $ toEditRoute' rScope workflowInstanceName
      mayList <- lift . hasReadAccessTo $ toListRoute' rScope workflowInstanceName
      mayUpdate <- lift . hasWriteAccessTo $ toUpdateRoute' rScope workflowInstanceName
      guard $ mayInitiate || mayEdit || mayList || mayUpdate
      canUpdate <- lift $ workflowInstanceCanUpdate wiId
      return (rScope, [(wi, desc, canUpdate)])

    let iSortProj (Entity _ WorkflowInstance{..}, mDesc, _)
          = ( NTop workflowInstanceCategory
            , workflowInstanceDescriptionTitle <$> mDesc
            , workflowInstanceName
            )
    return $ sortOn iSortProj <$> Map.fromListWith (<>) wis'

  siteLayoutMsg heading $ do
    setTitleI title
    let instanceList rScope instances = $(widgetFile "workflows/instances")
          where 
            toInitiateRoute = toInitiateRoute' rScope
            toEditRoute = toEditRoute' rScope
            toListRoute = toListRoute' rScope
            toUpdateRoute = toUpdateRoute' rScope
            mPitch :: Maybe Widget
            mPitch = Nothing
            updateForm win = maybeT mempty . guardMOnM (lift . hasWriteAccessTo $ toUpdateRoute win) $ do
              (updateWdgt, updateEnctype) <- liftHandler . generateFormPost . buttonForm' $ pure BtnWorkflowInstanceUpdate
              lift $ wrapForm updateWdgt def
                { formAction = Just . SomeRoute $ toUpdateRoute win
                , formEncoding = updateEnctype
                , formSubmit = FormNoSubmit
                }
        showHeadings = Map.keys gInstances /= [WSGlobal]
        pitch = $(i18nWidgetFile "workflow-instance-list-explanation")

    $(widgetFile "workflows/top-instances")
  
  where
    toInitiateRoute' rScope win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIInitiateR)
    toEditRoute' rScope win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIEditR)
    toListRoute' rScope win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIWorkflowsR)
    toUpdateRoute' rScope win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIUpdateR)

    (title, heading) = (MsgTopWorkflowInstancesTitle, MsgTopWorkflowInstancesHeading)
