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

module Handler.Workflow.Definition.List
  ( getAdminWorkflowDefinitionListR, postAdminWorkflowDefinitionListR
  ) where

import Import

import Handler.Utils

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

import qualified Data.Yaml as Yaml

import qualified Data.CaseInsensitive as CI


type WorkflowDefinitionTableExpr = E.SqlExpr (Entity WorkflowDefinition)
  
queryWorkflowDefinition :: Iso' WorkflowDefinitionTableExpr (E.SqlExpr (Entity WorkflowDefinition))
queryWorkflowDefinition = id

queryWorkflowInstanceCount, queryWorkflowCount :: Getter WorkflowDefinitionTableExpr (E.SqlExpr (E.Value Int64))
queryWorkflowInstanceCount = to $ \(view queryWorkflowDefinition -> workflowDefinition) ->
  E.subSelectCount . E.from $ \workflowInstance ->
    E.where_ $ workflowInstance E.^. WorkflowInstanceDefinition E.==. E.just (workflowDefinition E.^. WorkflowDefinitionId)
queryWorkflowCount = to $ \(view queryWorkflowDefinition -> workflowDefinition) ->
  E.subSelectCount . E.from $ \(workflowInstance `E.InnerJoin` workflow) -> do
    E.on $ workflow E.^. WorkflowWorkflowInstance E.==. E.just (workflowInstance E.^. WorkflowInstanceId)
    E.where_ $ workflowInstance E.^. WorkflowInstanceDefinition E.==. E.just (workflowDefinition E.^. WorkflowDefinitionId)



type WorkflowDefinitionData = DBRow
  ( Entity WorkflowDefinition
  , Maybe (Entity WorkflowDefinitionDescription)
  , Int64, Int64
  )

resultDefinition :: Lens' WorkflowDefinitionData (Entity WorkflowDefinition)
resultDefinition = _dbrOutput . _1

resultDescription :: Traversal' WorkflowDefinitionData (Entity WorkflowDefinitionDescription)
resultDescription = _dbrOutput . _2 . _Just

resultWorkflowInstanceCount, resultWorkflowCount :: Lens' WorkflowDefinitionData Int64
resultWorkflowInstanceCount = _dbrOutput . _3
resultWorkflowCount = _dbrOutput . _4


getAdminWorkflowDefinitionListR, postAdminWorkflowDefinitionListR :: Handler Html
getAdminWorkflowDefinitionListR = postAdminWorkflowDefinitionListR
postAdminWorkflowDefinitionListR = do
  definitionsTable <- runDB $
    let
      workflowDefinitionsDBTable = DBTable{..}
        where
          dbtSQLQuery = runReaderT $ do
            workflowDefinition <- view queryWorkflowDefinition
            workflowInstanceCount <- view queryWorkflowInstanceCount
            workflowCount <- view queryWorkflowCount

            return (workflowDefinition, workflowInstanceCount, workflowCount)
          dbtRowKey = (E.^. WorkflowDefinitionId)
          dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ do
            wd@(Entity wdId _) <- view _1
            descLangs <- lift . E.select . E.from $ \workflowDefinitionDescription -> do
              E.where_ $ workflowDefinitionDescription E.^. WorkflowDefinitionDescriptionDefinition E.==. E.val wdId
              return $ workflowDefinitionDescription E.^. WorkflowDefinitionDescriptionLanguage
            descLang <- traverse selectLanguage . nonEmpty $ E.unValue <$> descLangs
            desc <- lift . fmap join . for descLang $ \descLang' -> getBy $ UniqueWorkflowDefinitionDescription wdId descLang'
            (wd, desc,,)
              <$> view (_2 . _Value)
              <*> view (_3 . _Value)
          dbtColonnade :: Colonnade Sortable WorkflowDefinitionData _
          dbtColonnade = mconcat
            [ sortable (Just "name") (i18nCell MsgWorkflowDefinitionName) . anchorEdit $ views (resultDefinition . _entityVal . _workflowDefinitionName) i18n
            , sortable (Just "scope") (i18nCell MsgWorkflowDefinitionScope) $ views (resultDefinition . _entityVal . _workflowDefinitionScope) i18nCell
            , sortable (Just "title") (i18nCell MsgWorkflowDefinitionDescriptionTitle) $ maybe mempty (anchorEdit . const . i18n) =<< preview (resultDescription . _entityVal . _workflowDefinitionDescriptionTitle)
            , sortable (Just "instances") (i18nCell MsgWorkflowDefinitionInstanceCount) $ maybe mempty i18nCell . views resultWorkflowInstanceCount (assertM' (> 0))
            , sortable (Just "workflows") (i18nCell MsgWorkflowDefinitionWorkflowCount) $ maybe mempty i18nCell . views resultWorkflowCount (assertM' (> 0))
            , sortable (Just "description") (i18nCell MsgWorkflowDefinitionDescription) $ maybe mempty modalCell . preview (resultDescription . _entityVal . _workflowDefinitionDescriptionDescription . _Just)
            , sortable Nothing (i18nCell MsgWorkflowDefinitionGraph) $ views (resultDefinition . _entityVal . _workflowDefinitionGraph) (modalCell . displayGraph)
            ]
            where
              anchorEdit :: (WorkflowDefinitionData -> Widget) -> _
              anchorEdit = anchorCell' (\(view $ resultDefinition . _entityVal -> WorkflowDefinition{..}) -> AdminWorkflowDefinitionR workflowDefinitionScope workflowDefinitionName AWDEditR)
              displayGraph graph
                = [shamlet|
                    $newline never
                    <code .json>
                      #{graph'}
                  |]
                where graph' = decodeUtf8 $ Yaml.encode graph
          dbtSorting = mconcat
            [ singletonMap "name" . SortColumn $ views queryWorkflowDefinition (E.^. WorkflowDefinitionName)
            , singletonMap "scope" . SortColumn . views queryWorkflowDefinition $ E.orderByEnum . (E.^. WorkflowDefinitionScope)
            , singletonMap "title" . SortProjected . comparing . view $ resultDescription . _entityVal . _workflowDefinitionDescriptionTitle
            , singletonMap "description" . SortProjected . comparing . view $ resultDescription . _entityVal . _workflowDefinitionDescriptionDescription
            , singletonMap "instances" . SortColumn $ view queryWorkflowInstanceCount
            , singletonMap "workflows" . SortColumn $ view queryWorkflowCount
            ]
          dbtFilter = mconcat
            [ singletonMap "name" . FilterColumn $ E.mkContainsFilter (E.^. WorkflowDefinitionName)
            , singletonMap "scope" . FilterColumn $ E.mkExactFilter (E.^. WorkflowDefinitionScope)
            , singletonMap "title" . FilterProjected $ \(ts :: Set Text) (view $ resultDescription . _entityVal . _workflowDefinitionDescriptionTitle -> t) -> oany ((flip isInfixOf `on` CI.foldCase) t) ts
            ]
          dbtFilterUI mPrev = mconcat
            [ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgWorkflowDefinitionName)
            , prismAForm (singletonFilter "scope" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgNoFilter) optionsFinite :: Field _ WorkflowInstanceScope') (fslI MsgWorkflowDefinitionScope)
            , prismAForm (singletonFilter "title") mPrev $ aopt textField (fslI MsgWorkflowDefinitionDescriptionTitle)
            ]
          dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
          dbtParams = def
          dbtIdent :: Text
          dbtIdent = "workflow-definitions"
          dbtCsvEncode = noCsvEncode
          dbtCsvDecode = Nothing
      workflowDefinitionsDBTableValidator = def
        & defaultPagesize PagesizeAll
        & defaultSorting [SortAscBy "scope", SortAscBy "name"]
    in dbTableWidget' workflowDefinitionsDBTableValidator workflowDefinitionsDBTable

  siteLayoutMsg MsgWorkflowDefinitionListTitle $ do
    setTitleI MsgWorkflowDefinitionListTitle

    definitionsTable