{-# LANGUAGE AllowAmbiguousTypes #-}
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
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
makeDashboardSection :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO SomeView
makePageView :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Int -> Int -> IO SomeView
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)
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
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 ()
class JobsDashboard (jobs :: [Type]) where
makeDashboard :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO SomeView
includedJobTables :: [Text]
indexPage :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO ()
listJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Text -> IO ()
listJob' :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Bool -> IO ()
viewJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Text -> UUID -> IO ()
viewJob' :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Bool -> IO ()
newJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Text -> IO ()
newJob' :: (?context :: ControllerContext, ?modelContext :: ModelContext) => Bool -> IO ()
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 ()
instance JobsDashboard '[] where
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 { currentPage :: Int
currentPage = Int
page, Int
totalItems :: Int
totalItems :: Int
totalItems, Int
pageSize :: Int
pageSize :: Int
pageSize, window :: 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)
instance {-# OVERLAPPABLE #-} (DisplayableJob job, JobsDashboard rest) => JobsDashboard (job:rest) where
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])
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
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
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
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
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
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
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,
Show (PrimaryKey table), GetTableName record ~ 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
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
retryJob :: (?context::ControllerContext, ?modelContext::ModelContext) =>
Text -> UUID -> IO ()
retryJob Text
table UUID
uuid = 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"
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)
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
retryJob' :: (?context::ControllerContext, ?modelContext::ModelContext) => IO ()
retryJob' = do
let table :: Text
table = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
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 ()
retryJob @(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) =>
IO ()
retryJob' @rest
= \(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)
(job
job.status)
(job
job.updatedAt)
(job
job.createdAt)
(job
job.lastError)
getTableName :: forall job. (DisplayableJob job) => job -> Text
getTableName :: forall job. DisplayableJob job => job -> Text
getTableName job
_ = forall record. Table record => Text
tableName @job
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."