{-# 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
job = do
        SomeView -> IO SomeView
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeView -> IO SomeView) -> SomeView -> IO SomeView
forall a b. (a -> b) -> a -> b
$ HtmlView -> SomeView
forall a. View a => a -> SomeView
SomeView (HtmlView -> SomeView) -> HtmlView -> SomeView
forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView (Html -> HtmlView) -> Html -> HtmlView
forall a b. (a -> b) -> a -> b
$ BaseJob -> Html
renderBaseJobDetailView (job -> BaseJob
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 = SomeView -> IO SomeView
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeView -> IO SomeView) -> SomeView -> IO SomeView
forall a b. (a -> b) -> a -> b
$ HtmlView -> SomeView
forall a. View a => a -> SomeView
SomeView (HtmlView -> SomeView) -> HtmlView -> SomeView
forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView (Html -> HtmlView) -> Html -> HtmlView
forall a b. (a -> b) -> a -> b
$ Text -> Html
renderNewBaseJobForm (Text -> Html) -> Text -> Html
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 job -> (job -> IO job) -> IO job
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> job -> IO job
forall a. (CanCreate a, ?modelContext::ModelContext) => a -> IO a
create
        () -> IO ()
forall a. a -> IO a
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 = SomeView -> IO SomeView
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeView -> IO SomeView) -> SomeView -> IO SomeView
forall a b. (a -> b) -> a -> b
$ HtmlView -> SomeView
forall a. View a => a -> SomeView
SomeView (HtmlView -> SomeView) -> HtmlView -> SomeView
forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView Html
[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 <- (Text -> IO SomeView) -> [Text] -> IO [SomeView]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (?modelContext::ModelContext, ?context::ControllerContext) =>
Text -> IO SomeView
Text -> IO SomeView
buildBaseJobTable [Text]
tableNames
        SomeView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render (SomeView -> IO ()) -> SomeView -> IO ()
forall a b. (a -> b) -> a -> b
$ [SomeView] -> SomeView
forall a. View a => a -> SomeView
SomeView [SomeView]
tables
        where
            getAllTableNames :: IO [Text]
getAllTableNames = (Only Text -> Text) -> [Only Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Only Text -> Text
forall {a}. Only a -> a
extractText ([Only Text] -> [Text]) -> IO [Only Text] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> () -> IO [Only Text]
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 = Text -> Text -> IO ()
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 = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
            options :: Options
options = Options
defaultPaginationOptions
            page :: Int
page = Int -> ByteString -> Int
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Int
1 ByteString
"page"
            pageSize :: Int
pageSize = Int -> ByteString -> Int
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault (Options -> Int
maxItems Options
options) ByteString
"maxItems"
        Int
totalItems <- (?modelContext::ModelContext) => Text -> IO Int
Text -> IO Int
totalRecordsForTable Text
table
        [BaseJob]
jobs <- (?modelContext::ModelContext) => Text -> Int -> Int -> IO [BaseJob]
Text -> Int -> Int -> IO [BaseJob]
queryBaseJobsFromTablePaginated Text
table (Int
page Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
pageSize
        let pagination :: Pagination
pagination = Pagination { $sel:currentPage:Pagination :: Int
currentPage = Int
page, Int
totalItems :: Int
$sel:totalItems:Pagination :: Int
totalItems, Int
pageSize :: Int
$sel:pageSize:Pagination :: Int
pageSize, $sel:window:Pagination :: Int
window = Options -> Int
windowSize Options
options }
        HtmlView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render (HtmlView -> IO ()) -> HtmlView -> IO ()
forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView (Html -> HtmlView) -> Html -> 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 = Text -> Text -> UUID -> IO ()
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
Text -> UUID -> IO BaseJob
queryBaseJob (ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName") (ByteString -> UUID
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"id")
        HtmlView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render (HtmlView -> IO ()) -> HtmlView -> IO ()
forall a b. (a -> b) -> a -> b
$ Html -> HtmlView
HtmlView (Html -> HtmlView) -> Html -> HtmlView
forall a b. (a -> b) -> a -> b
$ BaseJob -> Html
renderBaseJobDetailView BaseJob
baseJob

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

    deleteJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
deleteJob = Text -> Text -> UUID -> IO ()
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 = ByteString -> UUID
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"id"
            Text
table :: Text = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
        UUID -> Text -> IO Int64
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 ()
Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel Text
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" record deleted.")
        JobsDashboardController Any Any -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo JobsDashboardController Any Any
forall {k} (authType :: k) (jobs :: [*]).
JobsDashboardController authType jobs
ListJobsAction

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

    retryJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
retryJob = Text -> Text -> UUID -> IO ()
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 = ByteString -> UUID
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"id"
            Text
table :: Text = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
        Text -> UUID -> IO Int64
forall {b}.
(?modelContext::ModelContext, ToField b) =>
Text -> b -> IO Int64
retryJobById Text
table UUID
id
        (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel Text
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" record marked as 'retry'.")
        JobsDashboardController Any Any -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo JobsDashboardController Any Any
forall {k} (authType :: k) (jobs :: [*]).
JobsDashboardController authType jobs
ListJobsAction

        where retryJobById :: Text -> b -> IO Int64
retryJobById Text
table b
id = Query -> (Identifier, b) -> IO Int64
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 <- SomeView -> SomeView
forall a. View a => a -> SomeView
SomeView (SomeView -> SomeView) -> IO SomeView -> IO 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
        SomeView -> IO SomeView
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeView -> IO SomeView) -> SomeView -> IO SomeView
forall a b. (a -> b) -> a -> b
$ [SomeView] -> SomeView
forall a. View a => a -> SomeView
SomeView (SomeView
section SomeView -> [SomeView] -> [SomeView]
forall a. a -> [a] -> [a]
: [SomeView
restSections])

    -- | Recursively build list of included table names
    includedJobTables :: [Text]
includedJobTables = forall record. Table record => Text
tableName @job Text -> [Text] -> [Text]
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 <- [Text] -> IO [Text]
forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
        [SomeView]
baseJobTables <- (Text -> IO SomeView) -> [Text] -> IO [SomeView]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (?modelContext::ModelContext, ?context::ControllerContext) =>
Text -> IO SomeView
Text -> IO SomeView
buildBaseJobTable [Text]
notIncluded
        [SomeView] -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render ([SomeView] -> IO ()) -> [SomeView] -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeView
dashboardIncluded SomeView -> [SomeView] -> [SomeView]
forall a. a -> [a] -> [a]
: [SomeView]
baseJobTables

    listJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> IO ()
listJob Text
table = do
        let page :: Int
page = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Int
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
        SomeView -> IO ()
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 = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFirstTime (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            [Text]
notIncluded <- [Text] -> IO [Text]
forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
table Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Text -> Text -> Bool
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 = UUID -> Id' (GetTableName job)
forall a b. a -> b
unsafeCoerce UUID
uuid
        job
j <- Id' (GetTableName job)
-> IO (FetchResult (Id' (GetTableName job)) job)
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
        SomeView -> IO ()
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 = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFirstTime (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            [Text]
notIncluded <- [Text] -> IO [Text]
forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
table Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Text -> Text -> Bool
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 (ByteString -> UUID
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 Request
(?context::ControllerContext) => Request
request ByteString -> ByteString -> Bool
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 ()
Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" job started.")
                JobsDashboardController Any Any -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo JobsDashboardController Any Any
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
                SomeView -> IO ()
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 = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFirstTime (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            [Text]
notIncluded <- [Text] -> IO [Text]
forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
table Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Text -> Text -> Bool
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 = UUID -> Id' (GetTableName 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 ()
Text -> IO ()
setSuccessMessage (Text -> Text
columnNameToFieldLabel Text
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" record deleted.")
        JobsDashboardController Any Any -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo JobsDashboardController Any Any
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 = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFirstTime (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            [Text]
notIncluded <- [Text] -> IO [Text]
forall {p} {b}.
(?modelContext::ModelContext, ToField (In p), FromField b) =>
p -> IO [b]
getNotIncludedTableNames (forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @(job:rest))
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
table Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Text -> Text -> Bool
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 (ByteString -> UUID
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 = (Only b -> b) -> [Only b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Only b -> b
forall {a}. Only a -> a
extractText ([Only b] -> [b]) -> IO [Only b] -> IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> Only (In p) -> IO [Only 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 ?"
    (In p -> Only (In p)
forall a. a -> Only a
Only (In p -> Only (In p)) -> In p -> Only (In p)
forall a b. (a -> b) -> a -> b
$ p -> In p
forall a. a -> In a
In (p -> In p) -> p -> In p
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 <- Query -> Only Text -> IO [BaseJob]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery (ByteString -> Query
PG.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
queryString) (Text -> Only Text
forall a. a -> Only a
Only Text
tableName)
    [BaseJob]
baseJobs
        [BaseJob] -> ([BaseJob] -> Html) -> Html
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [BaseJob] -> Html
renderBaseJobTable Text
tableName
        Html -> (Html -> HtmlView) -> HtmlView
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Html -> HtmlView
Html -> HtmlView
HtmlView
        HtmlView -> (HtmlView -> SomeView) -> SomeView
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> HtmlView -> SomeView
forall a. View a => a -> SomeView
SomeView
        SomeView -> (SomeView -> IO SomeView) -> IO SomeView
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> SomeView -> IO SomeView
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    where
        queryString :: Text
queryString = Text
"SELECT ?, id, status, updated_at, created_at, last_error FROM "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName
            Text -> Text -> Text
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)
    (Id' (GetTableName job) -> UUID
forall a b. a -> b
unsafeCoerce (Id' (GetTableName job) -> UUID) -> Id' (GetTableName job) -> UUID
forall a b. (a -> b) -> a -> b
$ job
job.id) -- model Id type -> UUID. Pls don't use integer IDs for your jobs :)
    (job
job.status)
    (job
job.updatedAt)
    (job
job.createdAt)
    (job
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 :: 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]
_) <- Query -> [Text] -> IO [BaseJob]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery
        (ByteString -> Query
PG.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"select ?, id, status, updated_at, created_at, last_error from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where id = ?")
        [Text
table, UUID -> Text
forall a. Show a => a -> Text
tshow UUID
id]
    BaseJob -> IO BaseJob
forall a. a -> IO a
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 =
    Query -> Only Text -> IO [BaseJob]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r) =>
Query -> q -> IO [r]
sqlQuery
        (ByteString -> Query
PG.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"select ?, id, status, updated_at, created_at, last_error from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" OFFSET " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
page Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pageSize) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" LIMIT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
pageSize)
        (Text -> Only Text
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 (a :: k).
(AuthenticationMethod a, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO ()
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   = ((?modelContext::ModelContext) => IO ()) -> IO ()
forall action.
(?theAction::action, Controller action,
 ?modelContext::ModelContext, ?context::ControllerContext) =>
((?modelContext::ModelContext) => IO ()) -> IO ()
autoRefresh (((?modelContext::ModelContext) => IO ()) -> IO ())
-> ((?modelContext::ModelContext) => IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO ()
indexPage @jobs
    action JobsDashboardController authType jobs
ListJobAction'   = ((?modelContext::ModelContext) => IO ()) -> IO ()
forall action.
(?theAction::action, Controller action,
 ?modelContext::ModelContext, ?context::ControllerContext) =>
((?modelContext::ModelContext) => IO ()) -> IO ()
autoRefresh (((?modelContext::ModelContext) => IO ()) -> IO ())
-> ((?modelContext::ModelContext) => IO ()) -> IO ()
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'   = ((?modelContext::ModelContext) => IO ()) -> IO ()
forall action.
(?theAction::action, Controller action,
 ?modelContext::ModelContext, ?context::ControllerContext) =>
((?modelContext::ModelContext) => IO ()) -> IO ()
autoRefresh (((?modelContext::ModelContext) => IO ()) -> IO ())
-> ((?modelContext::ModelContext) => IO ()) -> IO ()
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
_ = Text -> IO ()
forall a. Text -> a
error Text
"Cannot call this action directly. Call the backtick function with no parameters instead."