{-# 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.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
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 (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 (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
$ Table job => Text
forall record. Table record => Text
tableName @job
createNewJob :: (?context :: ControllerContext, ?modelContext :: ModelContext) => IO ()
createNewJob = do
Record job => job
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
class JobsDashboard (jobs :: [*]) 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 :: IO SomeView
makeDashboard = SomeView -> IO SomeView
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 :: 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)
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, Show q) =>
Query -> q -> IO [r]
sqlQuery
Query
"SELECT table_name FROM information_schema.tables WHERE table_name LIKE '%_jobs'" ()
listJob :: Text -> IO ()
listJob = Text -> Text -> IO ()
forall a. Text -> a
error Text
"listJob: Requested job type not in JobsDashboard Type"
listJob' :: 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 :: Int -> Int -> Int -> Int -> 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 }
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 :: Text -> UUID -> IO ()
viewJob = Text -> Text -> UUID -> IO ()
forall a. Text -> a
error Text
"viewJob: Requested job type not in JobsDashboard Type"
viewJob' :: 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 :: Text -> IO ()
newJob = Text -> Text -> IO ()
forall a. Text -> a
error Text
"newJob: Requested job type not in JobsDashboard Type"
newJob' :: 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 authType (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, Show 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 :: Text -> UUID -> IO ()
deleteJob = Text -> Text -> UUID -> IO ()
forall a. Text -> a
error Text
"deleteJob: Requested job type not in JobsDashboard Type"
deleteJob' :: 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, Show 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 authType (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, Show 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 :: Text -> UUID -> IO ()
retryJob = Text -> Text -> UUID -> IO ()
forall a. Text -> a
error Text
"retryJob: Requested job type not in JobsDashboard Type"
retryJob' :: 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, Show 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 authType (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, Show 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 :: IO SomeView
makeDashboard = do
SomeView
section <- (DisplayableJob job, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO SomeView
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
<$> (JobsDashboard rest, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO SomeView
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO SomeView
makeDashboard @rest
SomeView -> IO SomeView
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 = Table job => Text
forall record. Table record => Text
tableName @job Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: JobsDashboard rest => [Text]
forall (jobs :: [*]). JobsDashboard jobs => [Text]
includedJobTables @rest
indexPage :: IO ()
indexPage = do
SomeView
dashboardIncluded <- (JobsDashboard (job : rest), ?context::ControllerContext,
?modelContext::ModelContext) =>
IO SomeView
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO SomeView
makeDashboard @(job:rest)
[Text]
notIncluded <- [Text] -> IO [Text]
forall a b.
(?modelContext::ModelContext, ToField (In a), FromField b,
Show a) =>
a -> IO [b]
getNotIncludedTableNames (JobsDashboard (job : rest) => [Text]
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)
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 :: 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 <- Int -> Int -> IO SomeView
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' :: 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 a b.
(?modelContext::ModelContext, ToField (In a), FromField b,
Show a) =>
a -> IO [b]
getNotIncludedTableNames (JobsDashboard (job : rest) => [Text]
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notIncluded) (Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
listJob' @'[] Bool
False)
if Table job => Text
forall record. Table record => Text
tableName @job Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
table
then Text -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Text -> IO ()
listJob @(job:rest) Text
table
else Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
listJob' @rest Bool
False
viewJob :: Text -> UUID -> IO ()
viewJob Text
_ UUID
uuid = do
let Id job
id :: Id job = UUID -> Id job
forall a b. a -> b
unsafeCoerce UUID
uuid
job
j <- Id job -> IO (FetchResult (Id job) job)
forall fetchable model.
(Fetchable fetchable model, Table model, FromRow model,
?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch Id job
id
SomeView
view <- job -> IO SomeView
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' :: 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 a b.
(?modelContext::ModelContext, ToField (In a), FromField b,
Show a) =>
a -> IO [b]
getNotIncludedTableNames (JobsDashboard (job : rest) => [Text]
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notIncluded) (Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
viewJob' @'[] Bool
False)
if Table job => Text
forall record. Table record => Text
tableName @job Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
table
then Text -> UUID -> IO ()
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 Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
viewJob' @rest Bool
False
newJob :: 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
(DisplayableJob job, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO ()
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 authType (jobs :: [*]).
JobsDashboardController authType jobs
ListJobsAction
else do
SomeView
view <- (DisplayableJob job, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO SomeView
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' :: 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 a b.
(?modelContext::ModelContext, ToField (In a), FromField b,
Show a) =>
a -> IO [b]
getNotIncludedTableNames (JobsDashboard (job : rest) => [Text]
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notIncluded) (Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
newJob' @'[] Bool
False)
if Table job => Text
forall record. Table record => Text
tableName @job Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
table
then Text -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Text -> IO ()
newJob @(job:rest) Text
table
else Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
newJob' @rest Bool
False
deleteJob :: Text -> UUID -> IO ()
deleteJob Text
table UUID
uuid = do
let Id job
id :: Id job = UUID -> Id job
forall a b. a -> b
unsafeCoerce UUID
uuid
Id job -> IO ()
forall record (table :: Symbol).
(?modelContext::ModelContext, Table record,
ToField (PrimaryKey table), Show (PrimaryKey table),
record ~ GetModelByTableName table) =>
Id' table -> IO ()
deleteRecordById @job Id 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 authType (jobs :: [*]).
JobsDashboardController authType jobs
ListJobsAction
deleteJob' :: 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 a b.
(?modelContext::ModelContext, ToField (In a), FromField b,
Show a) =>
a -> IO [b]
getNotIncludedTableNames (JobsDashboard (job : rest) => [Text]
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notIncluded) (Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
deleteJob' @'[] Bool
False)
if Table job => Text
forall record. Table record => Text
tableName @job Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
table
then Text -> UUID -> IO ()
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 Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
deleteJob' @rest Bool
False
= \(Only a
t) -> a
t
getNotIncludedTableNames :: a -> IO [b]
getNotIncludedTableNames a
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 a) -> IO [Only b]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r, Show q) =>
Query -> q -> IO [r]
sqlQuery
Query
"SELECT table_name FROM information_schema.tables WHERE table_name LIKE '%_jobs' AND table_name NOT IN ?"
(In a -> Only (In a)
forall a. a -> Only a
Only (In a -> Only (In a)) -> In a -> Only (In a)
forall a b. (a -> b) -> a -> b
$ a -> In a
forall a. a -> In a
In (a -> In a) -> a -> In a
forall a b. (a -> b) -> a -> b
$ a
includedNames)
buildBaseJobTable :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Text -> IO SomeView
buildBaseJobTable :: Text -> IO SomeView
buildBaseJobTable Text
tableName = do
[BaseJob]
baseJobs <- Query -> Only Text -> IO [BaseJob]
forall q r.
(?modelContext::ModelContext, ToRow q, FromRow r, Show q) =>
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 (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 :: job -> BaseJob
buildBaseJob job
job = Text
-> UUID -> JobStatus -> UTCTime -> UTCTime -> Maybe Text -> BaseJob
BaseJob
(Table job => Text
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
$ Proxy "id" -> job -> Id' (GetTableName job)
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "id" (Proxy "id")
Proxy "id"
#id job
job)
(Proxy "status" -> job -> JobStatus
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "status" (Proxy "status")
Proxy "status"
#status job
job)
(Proxy "updatedAt" -> job -> UTCTime
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "updatedAt" (Proxy "updatedAt")
Proxy "updatedAt"
#updatedAt job
job)
(Proxy "createdAt" -> job -> UTCTime
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "createdAt" (Proxy "createdAt")
Proxy "createdAt"
#createdAt job
job)
(Proxy "lastError" -> job -> Maybe Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "lastError" (Proxy "lastError")
Proxy "lastError"
#lastError job
job)
getTableName :: forall job. (DisplayableJob job) => job -> Text
getTableName :: job -> Text
getTableName job
_ = Table job => Text
forall record. Table record => Text
tableName @job
queryBaseJob :: (?modelContext :: ModelContext) => Text -> UUID -> IO BaseJob
queryBaseJob :: 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, Show q) =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure BaseJob
job
queryBaseJobsFromTablePaginated :: (?modelContext :: ModelContext) => Text -> Int -> Int -> IO [BaseJob]
queryBaseJobsFromTablePaginated :: 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, Show q) =>
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 :: IO ()
beforeAction = (AuthenticationMethod authType, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO ()
forall a.
(AuthenticationMethod a, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO ()
authenticate @authType
action :: 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
$ (JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO ()
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
$ Bool -> IO ()
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
$ Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
viewJob' @jobs Bool
True
action JobsDashboardController authType jobs
CreateJobAction' = Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
newJob' @jobs Bool
True
action JobsDashboardController authType jobs
DeleteJobAction' = Bool -> IO ()
forall (jobs :: [*]).
(JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
Bool -> IO ()
deleteJob' @jobs Bool
True
action JobsDashboardController authType jobs
RetryJobAction' = (JobsDashboard jobs, ?context::ControllerContext,
?modelContext::ModelContext) =>
IO ()
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."