{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}

{-|
Module: IHP.Job.Dashboard.View
Description:  Views for Job dashboard
-}
module IHP.Job.Dashboard.View where

import IHP.Prelude
import IHP.ViewPrelude (JobStatus(..), ControllerContext, Html, View, hsx, html, timeAgo)
import qualified Data.List as List
import IHP.Job.Dashboard.Types
import IHP.Job.Dashboard.Utils
import IHP.Pagination.Types
import IHP.Pagination.ViewFunctions

-- | Provides a type-erased view. This allows us to specify a view as a return type without needed
-- to know exactly what type the view will be, which in turn allows for custom implmentations of
-- almost all the view functions in this module. Go GADTs!
data SomeView where
    SomeView :: forall a. (View a) => a -> SomeView

-- | Since the only constructor for 'SomeView' requires that it is passed a 'View', we can use
-- that to implement a 'View' instance for 'SomeView'
instance View SomeView where
    html :: (?context::ControllerContext, ?view::SomeView) => SomeView -> Html
html (SomeView a
a) = let ?view = a
?view::a
a in a -> Html
forall theView.
(View theView, ?context::ControllerContext, ?view::theView) =>
theView -> Html
IHP.ViewPrelude.html a
a

-- | Define how to render a list of views as a view. Just concatenate them together!
instance (View a) => View [a] where
    html :: (?context::ControllerContext, ?view::[a]) => [a] -> Html
html [] = [hsx||]
    html (a
x:[a]
xs) =
        -- need to nest let's here in order to satisfy the implicit ?view parameter for 'html'.
        -- ?view needs to be the type of the view being rendered, so set it before each render
        -- here we render single view
        let ?view = a
?view::a
x in
            let current :: Html
current = a -> Html
forall theView.
(View theView, ?context::ControllerContext, ?view::theView) =>
theView -> Html
IHP.ViewPrelude.html a
x in
                -- now rendering a list view
                let ?view = ?view::[a]
[a]
xs in
                    let rest :: Html
rest = [a] -> Html
forall theView.
(View theView, ?context::ControllerContext, ?view::theView) =>
theView -> Html
IHP.ViewPrelude.html [a]
xs in
                        [hsx|{current}{rest}|]

-- | A view containing no data. Used occasionally as a default implementation for some functions.
data EmptyView = EmptyView
instance View EmptyView where
    html :: (?context::ControllerContext, ?view::EmptyView) =>
EmptyView -> Html
html EmptyView
_ = [hsx||]

-- | A view constructed from some HTML.
newtype HtmlView = HtmlView Html
instance View HtmlView where
    html :: (?context::ControllerContext, ?view::HtmlView) => HtmlView -> Html
html (HtmlView Html
html) = [hsx|{html}|]

renderStatus :: r -> Html
renderStatus r
job = case r
job.status of
    JobStatus
JobStatusNotStarted -> [hsx|<span class="badge badge-secondary">Not Started</span>|]
    JobStatus
JobStatusRunning -> [hsx|<span class="badge badge-primary">Running</span>|]
    JobStatus
JobStatusFailed -> [hsx|<span class="badge badge-danger" title="Last Error" data-container="body" data-toggle="popover" data-placement="left" data-content={fromMaybe "" (job.lastError)}>Failed</span>|]
    JobStatus
JobStatusSucceeded -> [hsx|<span class="badge badge-success">Succeeded</span>|]
    JobStatus
JobStatusRetry -> [hsx|<span class="badge badge-warning" title="Last Error" data-container="body" data-toggle="popover" data-placement="left" data-content={fromMaybe "" (job.lastError)}>Retry</span>|]
    JobStatus
JobStatusTimedOut -> [hsx|<span class="badge badge-danger" >Timed Out</span>|]

-- BASE JOB VIEW HELPERS --------------------------------

renderBaseJobTable :: Text -> [BaseJob] -> Html
renderBaseJobTable :: Text -> [BaseJob] -> Html
renderBaseJobTable Text
table [BaseJob]
rows =
    let
        [Text]
headers :: [Text] = [Text
"ID", Text
"Updated At", Text
"Status", Text
"", Text
""]
        humanTitle :: Text
humanTitle = Text
table Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
columnNameToFieldLabel
    in [hsx|
    <div>
        <div class="d-flex justify-content-between align-items-center">
            <h3>{humanTitle}</h3>
            {renderNewBaseJobLink table}
        </div>
        <table class="table table-sm table-hover">
            <thead>
                <tr>
                    {forEach headers renderHeader}
                </tr>
            </thead>

            <tbody>
                {forEach rows renderBaseJobTableRow}
            </tbody>
        </table>
        <a href={ListJobAction table 1} class="link-primary">See all {humanTitle}</a>
        <hr />
    </div>
|]
    where renderHeader :: a -> Html
renderHeader a
field = [hsx|<th>{field}</th>|]

renderBaseJobTablePaginated :: Text -> [BaseJob] -> Pagination -> Html
renderBaseJobTablePaginated :: Text -> [BaseJob] -> Pagination -> Html
renderBaseJobTablePaginated Text
table [BaseJob]
jobs Pagination
pagination =
    let
        [Text]
headers :: [Text] = [Text
"ID", Text
"Updated At", Text
"Status", Text
"", Text
""]
        lastJobIndex :: Int
lastJobIndex = ([BaseJob] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [BaseJob]
jobs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    in
        [hsx|
            <div>
                <div class="d-flex justify-content-between align-items-center">
                    <h3>{table |> columnNameToFieldLabel}</h3>
                    {renderNewBaseJobLink table}
                </div>
                <table class="table table-sm table-hover">
                    <thead>
                        <tr>
                            {forEach headers renderHeader}
                        </tr>
                    </thead>

                    <tbody>
                        {forEach jobs renderBaseJobTableRow}
                    </tbody>
                </table>
            </div>
            {renderPagination pagination}
        |]
    where
        renderHeader :: a -> Html
renderHeader a
field = [hsx|<th>{field}</th>|]

renderBaseJobTableRow :: BaseJob -> Html
renderBaseJobTableRow :: BaseJob -> Html
renderBaseJobTableRow BaseJob
job = [hsx|
        <tr>
            <td>{job.id}</td>
            <td>{job.updatedAt |> timeAgo}</td>
            <td>{renderStatus job}</td>
            <td><a href={ViewJobAction (job.table) (job.id)} class="text-primary">Show</a></td>
            <td>
                <form action={RetryJobAction (job.table) (job.id)} method="POST">
                    <button type="submit" style={retryButtonStyle} class="btn btn-link text-secondary">Retry</button>
                </form>
            </td>
        </tr>
    |]

-- | Link included in table to create a new job.
renderNewBaseJobLink :: Text -> Html
renderNewBaseJobLink :: Text -> Html
renderNewBaseJobLink Text
table =
    let
        link :: Text
link = Text
"/jobs/CreateJob?tableName=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
table
    in [hsx|
        <form action={link}>
            <button type="submit" class="btn btn-primary btn-sm">+ New Job</button>
        </form>
    |]

renderNewBaseJobForm :: Text -> Html
renderNewBaseJobForm :: Text -> Html
renderNewBaseJobForm Text
table = [hsx|
    <br>
        <h5>New Job: {table}</h5>
    <br>
    <form action="/jobs/CreateJob" method="POST">
        <input type="hidden" id="tableName" name="tableName" value={table}>
        <button type="submit" class="btn btn-primary">New Job</button>
    </form>
|]

renderBaseJobDetailView :: BaseJob -> Html
renderBaseJobDetailView :: BaseJob -> Html
renderBaseJobDetailView BaseJob
job = let table :: Text
table = BaseJob
job.table in [hsx|
    <br>
        <h5>Viewing Job {job.id} in {table |> columnNameToFieldLabel}</h5>
    <br>
    <table class="table">
        <tbody>
            <tr>
                <th>Updated At</th>
                <td>{job.updatedAt |> timeAgo} ({job.updatedAt})</td>
            </tr>
            <tr>
                <th>Created At</th>
                <td>{job.createdAt |> timeAgo} ({job.createdAt})</td>
            </tr>
            <tr>
                <th>Status</th>
                <td>{renderStatus job}</td>
            </tr>
            <tr>
                <th>Last Error</th>
                <td>{fromMaybe "No error" (job.lastError)}</td>
            </tr>
        </tbody>
    </table>

    <div class="d-flex flex-row">
        <form class="mr-2" action="/jobs/DeleteJob" method="POST">
            <input type="hidden" id="tableName" name="tableName" value={table}>
            <input type="hidden" id="id" name="id" value={tshow $ job.id}>
            <button type="submit" class="btn btn-danger">Delete</button>
        </form>
        <form action="/jobs/RetryJob" method="POST">
            <input type="hidden" id="tableName" name="tableName" value={table}>
            <input type="hidden" id="id" name="id" value={tshow $ job.id}>
            <button type="submit" class="btn btn-primary">Run again</button>
        </form>
    </div>
|]
------------------------------------------------------------------

-- TABLE VIEWABLE view helpers -----------------------------------
makeDashboardSectionFromTableViewable :: forall a. (TableViewable a
    , ?context :: ControllerContext
    , ?modelContext :: ModelContext) => IO SomeView
makeDashboardSectionFromTableViewable :: forall a.
(TableViewable a, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO SomeView
makeDashboardSectionFromTableViewable = do
    [a]
indexRows <- forall a.
(TableViewable a, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO [a]
getIndex @a
    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
$ [a] -> Html
forall a. TableViewable a => [a] -> Html
renderTableViewableTable [a]
indexRows

renderTableViewableTable :: forall a. TableViewable a => [a] -> Html
renderTableViewableTable :: forall a. TableViewable a => [a] -> Html
renderTableViewableTable [a]
rows = let
        headers :: [Text]
headers = forall a. TableViewable a => [Text]
tableHeaders @a
        title :: Text
title = forall a. TableViewable a => Text
tableTitle @a
        link :: Html
link = forall a. TableViewable a => Html
newJobLink @a
        renderRow :: a -> Html
renderRow = forall a. TableViewable a => a -> Html
renderTableRow @a
        table :: Text
table = forall a. TableViewable a => Text
modelTableName @a
    in [hsx|
    <div>
        <div class="d-flex justify-content-between align-items-center">
            <h3>{title}</h3>
            {link}
        </div>
        <table class="table table-sm table-hover">
            <thead>
                <tr>
                    {forEach headers renderHeader}
                </tr>
            </thead>

            <tbody>
                {forEach rows renderRow}
            </tbody>
        </table>
        <a href={ListJobAction table 1} class="link-primary">See all {title}</a>
        <hr />
    </div>
|]
    where renderHeader :: a -> Html
renderHeader a
field = [hsx|<th>{field}</th>|]



makeListPageFromTableViewable :: forall a. (TableViewable a, ?context :: ControllerContext, ?modelContext :: ModelContext) => Int -> Int -> IO SomeView
makeListPageFromTableViewable :: forall a.
(TableViewable a, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Int -> Int -> IO SomeView
makeListPageFromTableViewable Int
page Int
pageSize = do
    [a]
pageData <- forall a.
(TableViewable a, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
Int -> Int -> IO [a]
getPage @a (Int
page Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
pageSize
    Int
numPages <- (?modelContext::ModelContext) => Text -> Int -> IO Int
Text -> Int -> IO Int
numberOfPagesForTable (forall a. TableViewable a => Text
modelTableName @a) Int
pageSize
    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
$ [a] -> Int -> Int -> Html
forall a. TableViewable a => [a] -> Int -> Int -> Html
renderTableViewableTablePaginated [a]
pageData Int
page Int
numPages

renderTableViewableTablePaginated :: forall a. TableViewable a => [a] -> Int -> Int -> Html
renderTableViewableTablePaginated :: forall a. TableViewable a => [a] -> Int -> Int -> Html
renderTableViewableTablePaginated [a]
jobs Int
page Int
totalPages =
    let
        title :: Text
title = forall a. TableViewable a => Text
tableTitle @a
        table :: Text
table = forall a. TableViewable a => Text
modelTableName @a
        headers :: [Text]
headers = forall a. TableViewable a => [Text]
tableHeaders @a
        lastJobIndex :: Int
lastJobIndex = ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [a]
jobs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        newLink :: Html
newLink = forall a. TableViewable a => Html
newJobLink @a
    in
        [hsx|
            <div>
                <div class="d-flex justify-content-between align-items-center">
                    <h3>{title}</h3>
                    {newLink}
                </div>
                <table class="table table-sm table-hover">
                    <thead>
                        <tr>
                            {forEach headers renderHeader}
                        </tr>
                    </thead>

                    <tbody>
                        {forEach jobs renderTableRow}
                    </tbody>
                </table>
            </div>
            <nav aria-label="Page navigation example">
                <ul class="pagination justify-content-end">
                    {renderPrev}
                    {when (totalPages /= 1) renderDest}
                    {renderNext}
                </ul>
            </nav>
        |]
    where
        renderHeader :: a -> Html
renderHeader a
field = [hsx|<th>{field}</th>|]
        renderDest :: Html
renderDest = let table :: Text
table = forall a. TableViewable a => Text
modelTableName @a in [hsx|<li class="page-item active"><a class="page-link" href={ListJobAction table page}>{page}</a></li>|]
        renderPrev :: Html
renderPrev
            | Int
page Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [hsx||]
            | Bool
otherwise = let table :: Text
table = forall a. TableViewable a => Text
modelTableName @a in [hsx|
                <li class="page-item">
                    <a class="page-link" href={ListJobAction table (page - 1)} aria-label="Previous">
                        <span aria-hidden="true">&laquo;</span>
                        <span class="sr-only">Previous</span>
                    </a>
                </li>
        |]
        renderNext :: Html
renderNext
            | Int
page Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
totalPages Bool -> Bool -> Bool
|| Int
totalPages Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [hsx||]
            | Bool
otherwise = let table :: Text
table = forall a. TableViewable a => Text
modelTableName @a in [hsx|
                <li class="page-item">
                    <a class="page-link" href={ListJobAction table (page + 1)} aria-label="Next">
                        <span aria-hidden="true">&raquo;</span>
                        <span class="sr-only">Next</span>
                    </a>
                </li>
            |]
------------------------------------------------------------

retryButtonStyle :: Text
retryButtonStyle :: Text
retryButtonStyle = Text
"outline: none !important; padding: 0; border: 0; vertical-align: baseline;"