{-# 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, columnNameToFieldLabel)
import qualified Data.List as List
import IHP.Job.Dashboard.Types
import IHP.Job.Dashboard.Utils
import IHP.Pagination.Types
import IHP.Pagination.ViewFunctions
import qualified IHP.Log as Log

-- | 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 :: SomeView -> Html
html (SomeView a
a) = let ?view = 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 :: [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 = 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 = 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 :: EmptyView -> Html
html EmptyView
_ = [hsx||]

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

renderStatus :: model -> Html
renderStatus model
job = case Proxy "status" -> model -> JobStatus
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "status" (Proxy "status")
Proxy "status"
#status model
job 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 "" (get #lastError job)}>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 "" (get #lastError job)}>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 (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>{get #id job}</td>
            <td>{get #updatedAt job |> timeAgo}</td>
            <td>{renderStatus job}</td>
            <td><a href={ViewJobAction (get #table job) (get #id job)} class="text-primary">Show</a></td>
            <td>
                <form action={RetryJobAction (get #table job) (get #id job)} 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 = Proxy "table" -> BaseJob -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "table" (Proxy "table")
Proxy "table"
#table BaseJob
job in [hsx|
    <br>
        <h5>Viewing Job {get #id job} in {table |> columnNameToFieldLabel}</h5>
    <br>
    <table class="table">
        <tbody>
            <tr>
                <th>Updated At</th>
                <td>{get #updatedAt job |> timeAgo} ({get #updatedAt job})</td>
            </tr>
            <tr>
                <th>Created At</th>
                <td>{get #createdAt job |> timeAgo} ({get #createdAt job})</td>
            </tr>
            <tr>
                <th>Status</th>
                <td>{renderStatus job}</td>
            </tr>
            <tr>
                <th>Last Error</th>
                <td>{fromMaybe "No error" (get #lastError job)}</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 $ get #id job}>
            <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 $ get #id job}>
            <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 :: IO SomeView
makeDashboardSectionFromTableViewable = do
    [a]
indexRows <- (TableViewable a, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO [a]
forall a.
(TableViewable a, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
IO [a]
getIndex @a
    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
$ [a] -> Html
forall a. TableViewable a => [a] -> Html
renderTableViewableTable [a]
indexRows

renderTableViewableTable :: forall a. TableViewable a => [a] -> Html
renderTableViewableTable :: [a] -> Html
renderTableViewableTable [a]
rows = let
        headers :: [Text]
headers = TableViewable a => [Text]
forall a. TableViewable a => [Text]
tableHeaders @a
        title :: Text
title = TableViewable a => Text
forall a. TableViewable a => Text
tableTitle @a
        link :: Html
link = TableViewable a => Html
forall a. TableViewable a => Html
newJobLink @a
        renderRow :: a -> Html
renderRow = TableViewable a => a -> Html
forall a. TableViewable a => a -> Html
renderTableRow @a
        table :: Text
table = TableViewable a => Text
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 :: Int -> Int -> IO SomeView
makeListPageFromTableViewable Int
page Int
pageSize = do
    [a]
pageData <- Int -> Int -> IO [a]
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 (TableViewable a => Text
forall a. TableViewable a => Text
modelTableName @a) Int
pageSize
    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
$ [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 :: [a] -> Int -> Int -> Html
renderTableViewableTablePaginated [a]
jobs Int
page Int
totalPages =
    let
        title :: Text
title = TableViewable a => Text
forall a. TableViewable a => Text
tableTitle @a
        table :: Text
table = TableViewable a => Text
forall a. TableViewable a => Text
modelTableName @a
        headers :: [Text]
headers = TableViewable a => [Text]
forall a. TableViewable a => [Text]
tableHeaders @a
        lastJobIndex :: Int
lastJobIndex = ([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 = TableViewable a => Html
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 = TableViewable a => Text
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 = TableViewable a => Text
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 = TableViewable a => Text
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;"