{-# 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 (SomeView a) = let ?view = a in IHP.ViewPrelude.html a -- | Define how to render a list of views as a view. Just concatenate them together! instance (View a) => View [a] where html [] = [hsx||] html (x: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 = IHP.ViewPrelude.html x in -- now rendering a list view let ?view = xs in let rest = IHP.ViewPrelude.html 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 _ = [hsx||] -- | A view constructed from some HTML. newtype HtmlView = HtmlView Html instance View HtmlView where html (HtmlView html) = [hsx|{html}|] renderStatus job = case job.status of JobStatusNotStarted -> [hsx|Not Started|] JobStatusRunning -> [hsx|Running|] JobStatusFailed -> [hsx|Failed|] JobStatusSucceeded -> [hsx|Succeeded|] JobStatusRetry -> [hsx|Retry|] JobStatusTimedOut -> [hsx|Timed Out|] -- BASE JOB VIEW HELPERS -------------------------------- renderBaseJobTable :: Text -> [BaseJob] -> Html renderBaseJobTable table rows = let headers :: [Text] = ["ID", "Updated At", "Status", "", ""] humanTitle = table |> columnNameToFieldLabel in [hsx|
Updated At | {job.updatedAt |> timeAgo} ({job.updatedAt}) |
---|---|
Created At | {job.createdAt |> timeAgo} ({job.createdAt}) |
Status | {renderStatus job} |
Last Error | {fromMaybe "No error" (job.lastError)} |