content: {-# LANGUAGE AllowAmbiguousTypes #-}
  
  {-|
  Module: IHP.Job.Dashboard
  Description:  Auto-generate a dashboard for job types
  
  This module allows IHP applications to generate a dashboard for interacting with job types.
  To start, first define a type for the dashboard:
  
  > type MyDashboard = JobsDashboardController NoAuth '[]
  
  And include the following in the 'controllers' list of a FrontController:
  
  > parseRoute @MyDashboard
  
  This generates a dashboard with listings for all tables which have names ending with "_jobs".
  
  All views are fully customizable. For more info, see the documentation for 'DisplayableJob'.
  If you implement custom behavior for a job type, add it to the list in the Dashboard type:
  
  > type MyDashboard = JobsDashboardController NoAuth '[EmailUserJob, UpdateRecordJob]
  -}
  module IHP.Job.Dashboard (
      module IHP.Job.Dashboard.View,
      module IHP.Job.Dashboard.Auth,
      module IHP.Job.Dashboard.Types,
  
      JobsDashboard(..),
      DisplayableJob(..),
      JobsDashboardController(..),
      getTableName,
  ) where
  
  import IHP.Prelude
  import IHP.ModelSupport
  import IHP.ControllerPrelude
  import Unsafe.Coerce
  import IHP.Job.Queue ()
  import IHP.Pagination.Types
  import qualified Database.PostgreSQL.Simple.Types as PG
  import qualified Database.PostgreSQL.Simple.FromField as PG
  import qualified Database.PostgreSQL.Simple.ToField as PG
  import Network.Wai (requestMethod)
  import Network.HTTP.Types.Method (methodPost)
  
  import IHP.Job.Dashboard.Types
  import IHP.Job.Dashboard.View
  import IHP.Job.Dashboard.Auth
  import IHP.Job.Dashboard.Utils
  
  -- | The crazy list of type constraints for this class defines everything needed for a generic "Job".
  -- All jobs created through the IHP dev IDE will automatically satisfy these constraints and thus be able to
  -- be used as a 'DisplayableJob'.
  -- To customize the dashboard behavior for each job, you should provide a custom implementation of 'DisplayableJob'
  -- for your job type. Your custom implementations will then be used instead of the defaults.
  class ( job ~ GetModelByTableName (GetTableName job)
      , FilterPrimaryKey (GetTableName job)
      , FromRow job
      , Show (PrimaryKey (GetTableName job))
      , PG.FromField (PrimaryKey (GetTableName job))
      , PG.ToField (PrimaryKey (GetTableName job))
      , KnownSymbol (GetTableName job)
      , HasField "id" job (Id job)
      , HasField "status" job JobStatus
      , HasField "updatedAt" job UTCTime
      , HasField "createdAt" job UTCTime
      , HasField "lastError" job (Maybe Text)
      , CanUpdate job
      , CanCreate job
      , Record job
      , Show job
      , Eq job
      , Table job
      , Typeable job) => DisplayableJob job where
  
      -- | How this job's section should be displayed in the dashboard. By default it's displayed as a table,
      -- but this can be any arbitrary view! Make some cool graphs :)
      makeDashboardSection :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO SomeView
  
      makePageView :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Int -> Int -> IO SomeView
  
      -- | The content of the page that will be displayed for a detail view of this job.
      -- By default, the ID, Status, Created/Updated at times, and last error are displayed.
      -- Can be defined as any arbitrary view.
      makeDetailView :: (?context :: ControllerContext, ?modelContext :: ModelContext) => job -> IO SomeView
      makeDetailView job = do
          pure $ SomeView $ HtmlView $ renderBaseJobDetailView (buildBaseJob job)
  
      -- | The content of the page that will be displayed for the "new job" form of this job.
      -- By default, only the submit button is rendered. For additonal form data, define your own implementation.
      -- Can be defined as any arbitrary view, but it should be a form.
      makeNewJobView :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO SomeView
      makeNewJobView = pure $ SomeView $ HtmlView $ renderNewBaseJobForm $ tableName @job
  
      -- | The action run to create and insert a new value of this job into the database.
      -- By default, create an empty record and insert it.
      -- To add more data, define your own implementation.
      createNewJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO ()
      createNewJob = do
          newRecord @job |> create
          pure ()
  
  
  
  
  -- | Defines implementations for actions for acting on a dashboard made of some list of types.
  -- This is included to allow these actions to recurse on the types, isn't possible in an IHP Controller
  -- action implementation.
  --
  -- Later functions and typeclasses introduce constraints on the types in this list,
  -- so you'll get a compile error if you try and include a type that is not a job.
  class JobsDashboard (jobs :: [Type]) where
      -- | Creates the entire dashboard by recursing on the type list and calling 'makeDashboardSection' on each type.
      makeDashboard :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO SomeView
  
      includedJobTables :: [Text]
  
      -- | Renders the index page, which is the view returned from 'makeDashboard'.
      indexPage :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO ()
  
      listJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Text -> IO ()
      listJob' :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Bool -> IO ()
  
      -- | Renders the detail view page. Rescurses on the type list to find a type with the
      -- same table name as the "tableName" query parameter.
      viewJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Text -> UUID -> IO ()
      viewJob' :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Bool -> IO ()
  
      -- | If performed in a POST request, creates a new job depending on the "tableName" query parameter.
      -- If performed in a GET request, renders the new job from depending on said parameter.
      newJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Text -> IO ()
      newJob' :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Bool -> IO ()
  
      -- | Deletes a job from the database.
      deleteJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Text -> UUID -> IO ()
      deleteJob' :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Bool -> IO ()
  
      retryJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Text -> UUID -> IO ()
      retryJob' :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO ()
  
  -- If no types are passed, try to get all tables dynamically and render them as BaseJobs
  instance JobsDashboard '[] where
  
      -- | Invoked at the end of recursion
      makeDashboard = pure $ SomeView $ HtmlView [hsx|
          <script>
              function initPopover() {
                  $('[data-toggle="popover"]').popover({ trigger: 'hover click' })
              }
              $(document).on('ready turbolinks:load', initPopover);
              $(initPopover);
          </script>
          <style>
          .popover-body {
              background-color: #01313f;
              color: rgb(147, 161, 161);
              font-family: Monaco, Menlo, "Ubuntu Mono", Consolas, source-code-pro, monospace;
              font-size: 11px;
          }
          </style>
      |]
  
      includedJobTables = []
  
      indexPage = do
          tableNames <- getAllTableNames
          tables <- mapM buildBaseJobTable tableNames
          render $ SomeView tables
          where
              getAllTableNames = map extractText <$> sqlQuery
                  "SELECT table_name FROM information_schema.tables WHERE table_name LIKE '%_jobs'" ()
  
      listJob = error "listJob: Requested job type not in JobsDashboard Type"
      listJob' _ = do
          let table = param "tableName"
              options = defaultPaginationOptions
              page = paramOrDefault 1 "page"
              pageSize = paramOrDefault (maxItems options) "maxItems"
          totalItems <- totalRecordsForTable table
          jobs <- queryBaseJobsFromTablePaginated table (page - 1) pageSize
          let pagination = Pagination { currentPage = page, totalItems, pageSize, window = windowSize options }
          render $ HtmlView $ renderBaseJobTablePaginated table jobs pagination
  
      viewJob = error "viewJob: Requested job type not in JobsDashboard Type"
      viewJob' _ = do
          baseJob <- queryBaseJob (param "tableName") (param "id")
          render $ HtmlView $ renderBaseJobDetailView baseJob
  
      newJob = error "newJob: Requested job type not in JobsDashboard Type"
      newJob' _ = do
          if requestMethod request == methodPost
              then do
                  insertJob
                  setSuccessMessage (columnNameToFieldLabel (param "tableName") <> " job started.")
                  redirectTo ListJobsAction
              else render $ HtmlView $ renderNewBaseJobForm (param "tableName")
          where insertJob = sqlExec (PG.Query $ "INSERT into " <> param "tableName" <> " DEFAULT VALUES") ()
  
      deleteJob = error "deleteJob: Requested job type not in JobsDashboard Type"
      deleteJob' _ = do
          let id    :: UUID = param "id"
              table :: Text = param "tableName"
          delete id table
          setSuccessMessage (columnNameToFieldLabel table <> " record deleted.")
          redirectTo ListJobsAction
  
          where delete id table = sqlExec (PG.Query $ cs $ "DELETE FROM " <> table <> " WHERE id = ?") (Only id)
  
      retryJob = error "retryJob: Requested job type not in JobsDashboard Type"
      retryJob' = do
          let id    :: UUID = param "id"
              table :: Text = param "tableName"
          retryJobById table id
          setSuccessMessage (columnNameToFieldLabel table <> " record marked as 'retry'.")
          redirectTo ListJobsAction
  
          where retryJobById table id = sqlExec ("UPDATE ? SET status = 'job_status_retry' WHERE id = ?") (PG.Identifier table, id)
  
  
  -- | Defines the default implementation for a dashboard of a list of job types.
  -- We know the current job is a 'DisplayableJob', and we can recurse on the rest of the list to build the rest of the dashboard.
  -- You probably don't want to provide custom implementations for these. Read the documentation for each of the functions if
  -- you'd like to know how to customize the behavior. They mostly rely on the functions from 'DisplayableJob'.
  instance {-# OVERLAPPABLE #-} (DisplayableJob job, JobsDashboard rest) => JobsDashboard (job:rest) where
  
      -- | Recusively create a list of views that are concatenated together as 'SomeView's to build the dashboard.
      -- To customize, override 'makeDashboardSection' for each job.
      makeDashboard = do
          section <- makeDashboardSection @job
          restSections <- SomeView <$> makeDashboard @rest
          pure $ SomeView (section : [restSections])
  
      -- | Recursively build list of included table names
      includedJobTables = tableName @job : includedJobTables @rest
  
      -- | Build the dashboard and render it.
      indexPage = do
          dashboardIncluded <- makeDashboard @(job:rest)
          notIncluded <- getNotIncludedTableNames (includedJobTables @(job:rest))
          baseJobTables <- mapM buildBaseJobTable notIncluded
          render $ dashboardIncluded : baseJobTables
  
      listJob table = do
          let page = fromMaybe 1 $ param "page"
          page <- makePageView @job page 25
          render page
  
      listJob' isFirstTime = do
          let table = param "tableName"
  
          when isFirstTime $ do
              notIncluded <- getNotIncludedTableNames (includedJobTables @(job:rest))
              when (table `elem` notIncluded) (listJob' @'[] False)
  
          if tableName @job == table
              then listJob @(job:rest) table
              else listJob' @rest False
  
      -- | View the detail page for the job with a given uuid.
      viewJob _ uuid = do
          let id :: Id job = unsafeCoerce uuid
          j <- fetch id
          view <- makeDetailView @job j
          render view
  
      -- | For a given "tableName" parameter, try and recurse over the list of types
      -- in order to find a type with the some table name as the parameter.
      -- If one is found, attempt to construct an ID from the "id" parameter,
      -- and render a page using the type's implementation of 'makeDetailView'.
      -- If you want to customize the page, override that function instead.
      viewJob' isFirstTime = do
          let table = param "tableName"
  
          when isFirstTime $ do
              notIncluded <- getNotIncludedTableNames (includedJobTables @(job:rest))
              when (table `elem` notIncluded) (viewJob' @'[] False)
  
          if tableName @job == table
              then viewJob @(job:rest) table (param "id")
              else viewJob' @rest False
  
      -- For POST, create a new job using the job's implementation of 'createNewJob'.
      -- To include other request data and parameters, override that function, not this one.
      -- If it's a GET request, render a new job form with the job's implementation of 'makeNewJobView'.
      -- For customizing this form, override 'makeNewJobView'.
      newJob tableName = do
          if requestMethod request == methodPost
              then do
                  createNewJob @job
                  setSuccessMessage (columnNameToFieldLabel tableName <> " job started.")
                  redirectTo ListJobsAction
              else do
                  view <- makeNewJobView @job
                  render view
  
      -- | For a given "tableName" parameter, try and recurse over the list of types
      -- in order to find a type with the some table name as the parameter.
      -- If such a type is found, call newJob.
      newJob' isFirstTime = do
          let table = param "tableName"
  
          when isFirstTime $ do
              notIncluded <- getNotIncludedTableNames (includedJobTables @(job:rest))
              when (table `elem` notIncluded) (newJob' @'[] False)
  
          if tableName @job == table
              then newJob @(job:rest) table
              else newJob' @rest False
  
      -- | Delete job in 'table' with ID 'uuid'.
      deleteJob table uuid = do
          let id :: Id job = unsafeCoerce uuid
          deleteRecordById @job id
          setSuccessMessage (columnNameToFieldLabel table <> " record deleted.")
          redirectTo ListJobsAction
  
      -- | For a given "tableName" parameter, try and recurse over the list of types
      -- in order to find a type with the some table name as the parameter.
      -- If one is found, delete the record with the given id.
      deleteJob' isFirstTime = do
          let table = param "tableName"
  
          when isFirstTime $ do
              notIncluded <- getNotIncludedTableNames (includedJobTables @(job:rest))
              when (table `elem` notIncluded) (deleteJob' @'[] False)
  
          if tableName @job == table
              then deleteJob @(job:rest) table (param "id")
              else deleteJob' @rest False
  
      retryJob table uuid = do
          let id    :: UUID = param "id"
              table :: Text = param "tableName"
              retryJobById table id = sqlExec ("UPDATE ? SET status = 'job_status_retry' WHERE id = ?") (PG.Identifier table, id)
          retryJobById table id
          setSuccessMessage (columnNameToFieldLabel table <> " record marked as 'retry'.")
          redirectTo ListJobsAction
      retryJob' = do
          let table = param "tableName"
  
          if tableName @job == table
              then retryJob @(job:rest) table (param "id")
              else retryJob' @rest
  
  extractText = \(Only t) -> t
  getNotIncludedTableNames includedNames = map extractText <$> sqlQuery
      "SELECT table_name FROM information_schema.tables WHERE table_name LIKE '%_jobs' AND table_name NOT IN ?"
      (Only $ In $ includedNames)
  buildBaseJobTable :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Text -> IO SomeView
  buildBaseJobTable tableName = do
      baseJobs <- sqlQuery (PG.Query $ cs $ queryString) (Only tableName)
      baseJobs
          |> renderBaseJobTable tableName
          |> HtmlView
          |> SomeView
          |> pure
  
      where
          queryString = "SELECT ?, id, status, updated_at, created_at, last_error FROM "
              <> tableName
              <> " ORDER BY created_at DESC LIMIT 10"
  
  buildBaseJob :: forall job. (DisplayableJob job) => job -> BaseJob
  buildBaseJob job = BaseJob
      (tableName @job)
      (unsafeCoerce $ job.id) -- model Id type -> UUID. Pls don't use integer IDs for your jobs :)
      (job.status)
      (job.updatedAt)
      (job.createdAt)
      (job.lastError)
  
  
  -- | We can't always access the type of our job in order to use type application syntax for 'tableName'.
  -- This is just a convinence function for those cases.
  getTableName :: forall job. (DisplayableJob job) => job -> Text
  getTableName _ = tableName @job
  
  -- | Get the job with in the given table with the given ID as a 'BaseJob'.
  queryBaseJob :: (?modelContext :: ModelContext) => Text -> UUID -> IO BaseJob
  queryBaseJob table id = do
      (job : _) <- sqlQuery
          (PG.Query $ cs $ "select ?, id, status, updated_at, created_at, last_error from " <> table <> " where id = ?")
          [table, tshow id]
      pure job
  
  queryBaseJobsFromTablePaginated :: (?modelContext :: ModelContext) => Text -> Int -> Int -> IO [BaseJob]
  queryBaseJobsFromTablePaginated table page pageSize =
      sqlQuery
          (PG.Query $ cs $ "select ?, id, status, updated_at, created_at, last_error from " <> table <> " OFFSET " <> tshow (page * pageSize) <> " LIMIT " <> tshow pageSize)
          (Only table)
  
  instance (JobsDashboard jobs, AuthenticationMethod authType) => Controller (JobsDashboardController authType jobs) where
      beforeAction = authenticate @authType
      action ListJobsAction   = autoRefresh $ indexPage @jobs
      action ListJobAction'   = autoRefresh $ listJob' @jobs True
      action ViewJobAction'   = autoRefresh $ viewJob' @jobs True
      action CreateJobAction' = newJob' @jobs True
      action DeleteJobAction' = deleteJob' @jobs True
      action RetryJobAction'  = retryJob' @jobs
      action _ = error "Cannot call this action directly. Call the backtick function with no parameters instead."
  