{-# 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.ViewPrelude (Html, View, hsx, html, timeAgo, columnNameToFieldLabel)
import IHP.ModelSupport
import IHP.ControllerPrelude
import Unsafe.Coerce
import IHP.Job.Queue ()
import IHP.RouterPrelude hiding (get, tshow, error, map, putStrLn, elem)
import IHP.Pagination.Types
import qualified Database.PostgreSQL.Simple as PG
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 Database.PostgreSQL.Simple.FromRow (FromRow(..), field)
import Network.Wai (requestMethod)
import Network.HTTP.Types.Method (methodGet, methodPost)
import GHC.TypeLits

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
job = do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. View a => a -> SomeView
SomeView forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView forall a b. (a -> b) -> a -> b
$ BaseJob -> Html
renderBaseJobDetailView (forall job. DisplayableJob job => job -> BaseJob
buildBaseJob job
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. View a => a -> SomeView
SomeView forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView forall a b. (a -> b) -> a -> b
$ Text -> Html
renderNewBaseJobForm forall a b. (a -> b) -> a -> b
$ forall record. Table record => Text
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
        forall model. Record model => model
newRecord @job forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a. (CanCreate a, ?modelContext::ModelContext) => a -> IO a
create
        forall (f :: * -> *) a. Applicative f => a -> f a
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 :: [*]) 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 :: (?context::ControllerContext, ?modelContext::ModelContext) =>
IO SomeView
makeDashboard = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. View a => a -> SomeView
SomeView forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
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 :: [Text]
includedJobTables = []

    indexPage :: (?context::ControllerContext, ?modelContext::ModelContext) => IO ()
indexPage = do
        [Text]
tableNames <- IO [Text]
getAllTableNames
        [SomeView]
tables <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (?modelContext::ModelContext, ?context::ControllerContext) =>
Text -> IO SomeView
buildBaseJobTable [Text]
tableNames
        forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render forall a b. (a -> b) -> a -> b
$ forall a. View a => a -> SomeView
SomeView [SomeView]
tables
        where
            getAllTableNames :: IO [Text]
getAllTableNames = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Only a -> a
extractText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery
                Query
"SELECT table_name FROM information_schema.tables WHERE table_name LIKE '%_jobs'" ()

    listJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> IO ()
listJob = forall a. Text -> a
error Text
"listJob: Requested job type not in JobsDashboard Type"
    listJob' :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Bool -> IO ()
listJob' Bool
_ = do
        let table :: Text
table = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
            options :: Options
options = Options
defaultPaginationOptions
            page :: Int
page = forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Int
1 ByteString
"page"
            pageSize :: Int
pageSize = forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault (Options -> Int
maxItems Options
options) ByteString
"maxItems"
        Int
totalItems <- (?modelContext::ModelContext) => Text -> IO Int
totalRecordsForTable Text
table
        [BaseJob]
jobs <- (?modelContext::ModelContext) => Text -> Int -> Int -> IO [BaseJob]
queryBaseJobsFromTablePaginated Text
table (Int
page forall a. Num a => a -> a -> a
- Int
1) Int
pageSize
        let pagination :: Pagination
pagination = Pagination { $sel:currentPage:Pagination :: Int
currentPage = Int
page, Int
$sel:totalItems:Pagination :: Int
totalItems :: Int
totalItems, Int
$sel:pageSize:Pagination :: Int
pageSize :: Int
pageSize, $sel:window:Pagination :: Int
window = Options -> Int
windowSize Options
options }
        forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView forall a b. (a -> b) -> a -> b
$ Text -> [BaseJob] -> Pagination -> Html
renderBaseJobTablePaginated Text
table [BaseJob]
jobs Pagination
pagination

    viewJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
viewJob = forall a. Text -> a
error Text
"viewJob: Requested job type not in JobsDashboard Type"
    viewJob' :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Bool -> IO ()
viewJob' Bool
_ = do
        BaseJob
baseJob <- (?modelContext::ModelContext) => Text -> UUID -> IO BaseJob
queryBaseJob (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName") (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"id")
        forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView forall a b. (a -> b) -> a -> b
$ BaseJob -> Html
renderBaseJobDetailView BaseJob
baseJob

    newJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> IO ()
newJob = forall a. Text -> a
error Text
"newJob: Requested job type not in JobsDashboard Type"
    newJob' :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Bool -> IO ()
newJob' Bool
_ = do
        if Request -> ByteString
requestMethod (?context::ControllerContext) => Request
request forall a. Eq a => a -> a -> Bool
== ByteString
methodPost
            then do
                IO Int64
insertJob
                (?context::ControllerContext) => Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName") forall a. Semigroup a => a -> a -> a
<> Text
" job started.")
                forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo forall {k} (authType :: k) (jobs :: [*]).
JobsDashboardController authType jobs
ListJobsAction
            else forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView forall a b. (a -> b) -> a -> b
$ Text -> Html
renderNewBaseJobForm (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName")
        where insertJob :: IO Int64
insertJob = forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO Int64
sqlExec (ByteString -> Query
PG.Query forall a b. (a -> b) -> a -> b
$ ByteString
"INSERT into " forall a. Semigroup a => a -> a -> a
<> forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName" forall a. Semigroup a => a -> a -> a
<> ByteString
" DEFAULT VALUES") ()

    deleteJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
deleteJob = forall a. Text -> a
error Text
"deleteJob: Requested job type not in JobsDashboard Type"
    deleteJob' :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Bool -> IO ()
deleteJob' Bool
_ = do
        let UUID
id    :: UUID = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"id"
            Text
table :: Text = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
        forall {a} {a}.
(?modelContext::ModelContext, ToField a,
 ConvertibleStrings a ByteString, Semigroup a, IsString a) =>
a -> a -> IO Int64
delete UUID
id Text
table
        (?context::ControllerContext) => Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel Text
table forall a. Semigroup a => a -> a -> a
<> Text
" record deleted.")
        forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo forall {k} (authType :: k) (jobs :: [*]).
JobsDashboardController authType jobs
ListJobsAction

        where delete :: a -> a -> IO Int64
delete a
id a
table = forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO Int64
sqlExec (ByteString -> Query
PG.Query forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ a
"DELETE FROM " forall a. Semigroup a => a -> a -> a
<> a
table forall a. Semigroup a => a -> a -> a
<> a
" WHERE id = ?") (forall a. a -> Only a
Only a
id)

    retryJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
retryJob = forall a. Text -> a
error Text
"retryJob: Requested job type not in JobsDashboard Type"
    retryJob' :: (?context::ControllerContext, ?modelContext::ModelContext) => IO ()
retryJob' = do
        let UUID
id    :: UUID = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"id"
            Text
table :: Text = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
        forall {b}.
(?modelContext::ModelContext, ToField b) =>
Text -> b -> IO Int64
retryJobById Text
table UUID
id
        (?context::ControllerContext) => Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel Text
table forall a. Semigroup a => a -> a -> a
<> Text
" record marked as 'retry'.")
        forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo forall {k} (authType :: k) (jobs :: [*]).
JobsDashboardController authType jobs
ListJobsAction

        where retryJobById :: Text -> b -> IO Int64
retryJobById Text
table b
id = forall q.
(?modelContext::ModelContext, ToRow q) =>
Query -> q -> IO Int64
sqlExec (Query
"UPDATE ? SET status = 'job_status_retry' WHERE id = ?") (Text -> Identifier
PG.Identifier Text
table, b
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 :: (?context::ControllerContext, ?modelContext::ModelContext) =>
IO SomeView
makeDashboard = do
        SomeView
section <- forall job.
(DisplayableJob job, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO SomeView
makeDashboardSection @job
        SomeView
restSections <- forall a. View a => a -> SomeView
SomeView forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO SomeView
makeDashboard @rest
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. View a => a -> SomeView
SomeView (SomeView
section forall a. a -> [a] -> [a]
: [SomeView
restSections])

    -- | Recursively build list of included table names
    includedJobTables :: [Text]
includedJobTables = forall record. Table record => Text
tableName @job forall a. a -> [a] -> [a]
: forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @rest

    -- | Build the dashboard and render it.
    indexPage :: (?context::ControllerContext, ?modelContext::ModelContext) => IO ()
indexPage = do
        SomeView
dashboardIncluded <- forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO SomeView
makeDashboard @(job:rest)
        [Text]
notIncluded <- forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
        [SomeView]
baseJobTables <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (?modelContext::ModelContext, ?context::ControllerContext) =>
Text -> IO SomeView
buildBaseJobTable [Text]
notIncluded
        forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render forall a b. (a -> b) -> a -> b
$ SomeView
dashboardIncluded forall a. a -> [a] -> [a]
: [SomeView]
baseJobTables

    listJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> IO ()
listJob Text
table = do
        let page :: Int
page = forall a. a -> Maybe a -> a
fromMaybe Int
1 forall a b. (a -> b) -> a -> b
$ forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"page"
        SomeView
page <- forall job.
(DisplayableJob job, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Int -> Int -> IO SomeView
makePageView @job Int
page Int
25
        forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render SomeView
page

    listJob' :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Bool -> IO ()
listJob' Bool
isFirstTime = do
        let table :: Text
table = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFirstTime forall a b. (a -> b) -> a -> b
$ do
            [Text]
notIncluded <- forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
table forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notIncluded) (forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
listJob' @'[] Bool
False)

        if forall record. Table record => Text
tableName @job forall a. Eq a => a -> a -> Bool
== Text
table
            then forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Text -> IO ()
listJob @(job:rest) Text
table
            else forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
listJob' @rest Bool
False

    -- | View the detail page for the job with a given uuid.
    viewJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
viewJob Text
_ UUID
uuid = do
        let Id' (GetTableName job)
id :: Id job = forall a b. a -> b
unsafeCoerce UUID
uuid
        job
j <- forall fetchable model.
(Fetchable fetchable model, Table model, FromRow model,
 ?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch Id' (GetTableName job)
id
        SomeView
view <- forall job.
(DisplayableJob job, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
job -> IO SomeView
makeDetailView @job job
j
        forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render SomeView
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' :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Bool -> IO ()
viewJob' Bool
isFirstTime = do
        let table :: Text
table = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFirstTime forall a b. (a -> b) -> a -> b
$ do
            [Text]
notIncluded <- forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
table forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notIncluded) (forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
viewJob' @'[] Bool
False)

        if forall record. Table record => Text
tableName @job forall a. Eq a => a -> a -> Bool
== Text
table
            then forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
viewJob @(job:rest) Text
table (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"id")
            else forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
viewJob' @rest Bool
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 :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> IO ()
newJob Text
tableName = do
        if Request -> ByteString
requestMethod (?context::ControllerContext) => Request
request forall a. Eq a => a -> a -> Bool
== ByteString
methodPost
            then do
                forall job.
(DisplayableJob job, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO ()
createNewJob @job
                (?context::ControllerContext) => Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel Text
tableName forall a. Semigroup a => a -> a -> a
<> Text
" job started.")
                forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo forall {k} (authType :: k) (jobs :: [*]).
JobsDashboardController authType jobs
ListJobsAction
            else do
                SomeView
view <- forall job.
(DisplayableJob job, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO SomeView
makeNewJobView @job
                forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render SomeView
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' :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Bool -> IO ()
newJob' Bool
isFirstTime = do
        let table :: Text
table = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFirstTime forall a b. (a -> b) -> a -> b
$ do
            [Text]
notIncluded <- forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
table forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notIncluded) (forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
newJob' @'[] Bool
False)

        if forall record. Table record => Text
tableName @job forall a. Eq a => a -> a -> Bool
== Text
table
            then forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Text -> IO ()
newJob @(job:rest) Text
table
            else forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
newJob' @rest Bool
False

    -- | Delete job in 'table' with ID 'uuid'.
    deleteJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
deleteJob Text
table UUID
uuid = do
        let Id' (GetTableName job)
id :: Id job = forall a b. a -> b
unsafeCoerce UUID
uuid
        forall record (table :: Symbol).
(?modelContext::ModelContext, Table record,
 ToField (PrimaryKey table), Show (PrimaryKey table),
 record ~ GetModelByTableName table) =>
Id' table -> IO ()
deleteRecordById @job Id' (GetTableName job)
id
        (?context::ControllerContext) => Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel Text
table forall a. Semigroup a => a -> a -> a
<> Text
" record deleted.")
        forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo forall {k} (authType :: k) (jobs :: [*]).
JobsDashboardController authType jobs
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' :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Bool -> IO ()
deleteJob' Bool
isFirstTime = do
        let table :: Text
table = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFirstTime forall a b. (a -> b) -> a -> b
$ do
            [Text]
notIncluded <- forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
table forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notIncluded) (forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
deleteJob' @'[] Bool
False)

        if forall record. Table record => Text
tableName @job forall a. Eq a => a -> a -> Bool
== Text
table
            then forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
deleteJob @(job:rest) Text
table (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"id")
            else forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
deleteJob' @rest Bool
False


extractText :: Only a -> a
extractText = \(Only a
t) -> a
t
getNotIncludedTableNames :: p -> IO [b]
getNotIncludedTableNames p
includedNames = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Only a -> a
extractText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery
    Query
"SELECT table_name FROM information_schema.tables WHERE table_name LIKE '%_jobs' AND table_name NOT IN ?"
    (forall a. a -> Only a
Only forall a b. (a -> b) -> a -> b
$ forall a. a -> In a
In forall a b. (a -> b) -> a -> b
$ p
includedNames)
buildBaseJobTable :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Text -> IO SomeView
buildBaseJobTable :: (?modelContext::ModelContext, ?context::ControllerContext) =>
Text -> IO SomeView
buildBaseJobTable Text
tableName = do
    [BaseJob]
baseJobs <- forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery (ByteString -> Query
PG.Query forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ Text
queryString) (forall a. a -> Only a
Only Text
tableName)
    [BaseJob]
baseJobs
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [BaseJob] -> Html
renderBaseJobTable Text
tableName
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Html -> HtmlView
HtmlView
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a. View a => a -> SomeView
SomeView
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall (f :: * -> *) a. Applicative f => a -> f a
pure

    where
        queryString :: Text
queryString = Text
"SELECT ?, id, status, updated_at, created_at, last_error FROM "
            forall a. Semigroup a => a -> a -> a
<> Text
tableName
            forall a. Semigroup a => a -> a -> a
<> Text
" ORDER BY created_at DESC LIMIT 10"

buildBaseJob :: forall job. (DisplayableJob job) => job -> BaseJob
buildBaseJob :: forall job. DisplayableJob job => job -> BaseJob
buildBaseJob job
job = Text
-> UUID -> JobStatus -> UTCTime -> UTCTime -> Maybe Text -> BaseJob
BaseJob
    (forall record. Table record => Text
tableName @job)
    (forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "id" a => a
#id job
job) -- model Id type -> UUID. Pls don't use integer IDs for your jobs :)
    (forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "status" a => a
#status job
job)
    (forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "updatedAt" a => a
#updatedAt job
job)
    (forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "createdAt" a => a
#createdAt job
job)
    (forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "lastError" a => a
#lastError job
job)


-- | 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 :: forall job. DisplayableJob job => job -> Text
getTableName job
_ = forall record. Table record => Text
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 :: (?modelContext::ModelContext) => Text -> UUID -> IO BaseJob
queryBaseJob Text
table UUID
id = do
    (BaseJob
job : [BaseJob]
_) <- forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery
        (ByteString -> Query
PG.Query forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ Text
"select ?, id, status, updated_at, created_at, last_error from " forall a. Semigroup a => a -> a -> a
<> Text
table forall a. Semigroup a => a -> a -> a
<> Text
" where id = ?")
        [Text
table, forall a. Show a => a -> Text
tshow UUID
id]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseJob
job

queryBaseJobsFromTablePaginated :: (?modelContext :: ModelContext) => Text -> Int -> Int -> IO [BaseJob]
queryBaseJobsFromTablePaginated :: (?modelContext::ModelContext) => Text -> Int -> Int -> IO [BaseJob]
queryBaseJobsFromTablePaginated Text
table Int
page Int
pageSize =
    forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery
        (ByteString -> Query
PG.Query forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ Text
"select ?, id, status, updated_at, created_at, last_error from " forall a. Semigroup a => a -> a -> a
<> Text
table forall a. Semigroup a => a -> a -> a
<> Text
" OFFSET " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (Int
page forall a. Num a => a -> a -> a
* Int
pageSize) forall a. Semigroup a => a -> a -> a
<> Text
" LIMIT " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
pageSize)
        (forall a. a -> Only a
Only Text
table)

instance (JobsDashboard jobs, AuthenticationMethod authType) => Controller (JobsDashboardController authType jobs) where
    beforeAction :: (?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::JobsDashboardController authType jobs) =>
IO ()
beforeAction = forall {k} (a :: k).
(AuthenticationMethod a, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO ()
authenticate @authType
    action :: (?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::JobsDashboardController authType jobs) =>
JobsDashboardController authType jobs -> IO ()
action JobsDashboardController authType jobs
ListJobsAction   = forall action.
(?theAction::action, Controller action,
 ?modelContext::ModelContext, ?context::ControllerContext) =>
((?modelContext::ModelContext) => IO ()) -> IO ()
autoRefresh forall a b. (a -> b) -> a -> b
$ forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO ()
indexPage @jobs
    action JobsDashboardController authType jobs
ListJobAction'   = forall action.
(?theAction::action, Controller action,
 ?modelContext::ModelContext, ?context::ControllerContext) =>
((?modelContext::ModelContext) => IO ()) -> IO ()
autoRefresh forall a b. (a -> b) -> a -> b
$ forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
listJob' @jobs Bool
True
    action JobsDashboardController authType jobs
ViewJobAction'   = forall action.
(?theAction::action, Controller action,
 ?modelContext::ModelContext, ?context::ControllerContext) =>
((?modelContext::ModelContext) => IO ()) -> IO ()
autoRefresh forall a b. (a -> b) -> a -> b
$ forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
viewJob' @jobs Bool
True
    action JobsDashboardController authType jobs
CreateJobAction' = forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
newJob' @jobs Bool
True
    action JobsDashboardController authType jobs
DeleteJobAction' = forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Bool -> IO ()
deleteJob' @jobs Bool
True
    action JobsDashboardController authType jobs
RetryJobAction'  = forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO ()
retryJob' @jobs
    action JobsDashboardController authType jobs
_ = forall a. Text -> a
error Text
"Cannot call this action directly. Call the backtick function with no parameters instead."