{-# 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.CanonicalRoute

import qualified Database.Esqueleto 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 (WorkflowScope TermId SchoolId CryptoUUIDCourse)
        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 = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ do
              wi@(Entity wiId _) <- view _1
              descLangs <- lift . E.select . E.from $ \workflowInstanceDescription -> do
                E.where_ $ workflowInstanceDescription E.^. WorkflowInstanceDescriptionInstance E.==. E.val wiId
                return $ workflowInstanceDescription E.^. WorkflowInstanceDescriptionLanguage
              descLang <- traverse selectLanguage . nonEmpty $ E.unValue <$> descLangs
              desc <- lift . fmap join . for descLang $ \descLang' -> getBy $ UniqueWorkflowInstanceDescription wiId descLang'
              (wi, desc,)
                <$> view (_2 . _Value)
            dbtColonnade :: Colonnade Sortable WorkflowInstanceData _
            dbtColonnade = mconcat
              [ sortable (Just "name") (i18nCell MsgWorkflowInstanceName) $ views (resultWorkflowInstance . _entityVal . _workflowInstanceName) i18nCell
              , 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)
              ]
            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" . FilterProjected $ \(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 MsgNoFilter) $ 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
        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 :: WorkflowScope TermId SchoolId (TermId, SchoolId, CourseShorthand) -> Handler Html
workflowInstanceListR rScope = 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 <- hasWriteAccessTo $ toInitiateRoute workflowInstanceName
      mayEdit <- hasReadAccessTo $ toEditRoute workflowInstanceName
      mayList <- hasReadAccessTo $ toListRoute workflowInstanceName
      guard $ mayInitiate || mayEdit || mayList
      return (wi, desc)

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

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

  siteLayoutMsg heading $ do
    setTitleI title
    $(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)

getTopWorkflowInstanceListR :: Handler Html
getTopWorkflowInstanceListR = 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 <- hasWriteAccessTo $ toInitiateRoute' rScope workflowInstanceName
      mayEdit <- hasReadAccessTo $ toEditRoute' rScope workflowInstanceName
      mayList <- hasReadAccessTo $ toListRoute' rScope workflowInstanceName
      guard $ mayInitiate || mayEdit || mayList
      return (rScope, [(wi, desc)])

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

  siteLayoutMsg MsgTopWorkflowInstancesHeading $ do
    setTitleI MsgTopWorkflowInstancesTitle
    let instanceList rScope instances = $(widgetFile "workflows/instances")
          where 
            toInitiateRoute = toInitiateRoute' rScope
            toEditRoute = toEditRoute' rScope
            toListRoute = toListRoute' rScope
        showHeadings = Map.keys gInstances /= [WSGlobal]
    $(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)