summaryrefslogtreecommitdiff
path: root/Omni
diff options
context:
space:
mode:
Diffstat (limited to 'Omni')
-rw-r--r--Omni/Jr/Web.hs54
-rw-r--r--Omni/Jr/Web/Style.hs102
-rw-r--r--Omni/Task/Core.hs16
3 files changed, 169 insertions, 3 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 28f42a2..d117169 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -21,6 +21,7 @@ import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
+import Data.Time (UTCTime, defaultTimeLocale, formatTime)
import qualified Lucid
import qualified Network.Wai.Handler.Warp as Warp
import qualified Omni.Jr.Web.Style as Style
@@ -74,7 +75,7 @@ newtype ReadyQueuePage = ReadyQueuePage [TaskCore.Task]
data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters
data TaskDetailPage
- = TaskDetailFound TaskCore.Task [TaskCore.Task]
+ = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity]
| TaskDetailNotFound Text
data TaskReviewPage
@@ -271,7 +272,7 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.code_ (Lucid.toHtml tid)
" could not be found."
Lucid.p_ [Lucid.class_ "back-link"] <| Lucid.a_ [Lucid.href_ "/tasks"] "← Back to Tasks"
- toHtml (TaskDetailFound task allTasks) =
+ toHtml (TaskDetailFound task allTasks activities) =
Lucid.doctypehtml_ <| do
pageHead (TaskCore.taskId task <> " - Jr")
Lucid.body_ <| do
@@ -342,6 +343,12 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.ul_ [Lucid.class_ "child-list"] <| do
traverse_ renderChild children
+ when (TaskCore.taskStatus task == TaskCore.InProgress && not (null activities)) <| do
+ Lucid.div_ [Lucid.class_ "activity-section"] <| do
+ Lucid.h3_ "Activity Timeline"
+ Lucid.div_ [Lucid.class_ "activity-timeline"] <| do
+ traverse_ renderActivity activities
+
when (TaskCore.taskStatus task == TaskCore.Review) <| do
Lucid.div_ [Lucid.class_ "review-link-section"] <| do
Lucid.a_
@@ -387,6 +394,45 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child)
Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]")
+ renderActivity :: (Monad m) => TaskCore.TaskActivity -> Lucid.HtmlT m ()
+ renderActivity act =
+ Lucid.div_ [Lucid.class_ ("activity-item " <> stageClass (TaskCore.activityStage act))] <| do
+ Lucid.div_ [Lucid.class_ "activity-icon"] (stageIcon (TaskCore.activityStage act))
+ Lucid.div_ [Lucid.class_ "activity-content"] <| do
+ Lucid.div_ [Lucid.class_ "activity-header"] <| do
+ Lucid.span_ [Lucid.class_ "activity-stage"] (Lucid.toHtml (tshow (TaskCore.activityStage act)))
+ Lucid.span_ [Lucid.class_ "activity-time"] (Lucid.toHtml (formatTimestamp (TaskCore.activityTimestamp act)))
+ case TaskCore.activityMessage act of
+ Nothing -> pure ()
+ Just msg -> Lucid.p_ [Lucid.class_ "activity-message"] (Lucid.toHtml msg)
+ case TaskCore.activityMetadata act of
+ Nothing -> pure ()
+ Just meta ->
+ Lucid.details_ [Lucid.class_ "activity-metadata"] <| do
+ Lucid.summary_ "Metadata"
+ Lucid.pre_ [Lucid.class_ "metadata-json"] (Lucid.toHtml meta)
+
+ stageClass :: TaskCore.ActivityStage -> Text
+ stageClass stage = case stage of
+ TaskCore.Claiming -> "stage-claiming"
+ TaskCore.Running -> "stage-running"
+ TaskCore.Reviewing -> "stage-reviewing"
+ TaskCore.Retrying -> "stage-retrying"
+ TaskCore.Completed -> "stage-completed"
+ TaskCore.Failed -> "stage-failed"
+
+ stageIcon :: (Monad m) => TaskCore.ActivityStage -> Lucid.HtmlT m ()
+ stageIcon stage = case stage of
+ TaskCore.Claiming -> "●"
+ TaskCore.Running -> "▶"
+ TaskCore.Reviewing -> "◎"
+ TaskCore.Retrying -> "↻"
+ TaskCore.Completed -> "✓"
+ TaskCore.Failed -> "✗"
+
+ formatTimestamp :: UTCTime -> Text
+ formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
+
instance Lucid.ToHtml TaskReviewPage where
toHtmlRaw = Lucid.toHtml
toHtml (ReviewPageNotFound tid) =
@@ -645,7 +691,9 @@ server =
tasks <- liftIO TaskCore.loadTasks
case TaskCore.findTask tid tasks of
Nothing -> pure (TaskDetailNotFound tid)
- Just task -> pure (TaskDetailFound task tasks)
+ Just task -> do
+ activities <- liftIO (TaskCore.getActivitiesForTask tid)
+ pure (TaskDetailFound task tasks activities)
taskStatusHandler :: Text -> StatusForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
taskStatusHandler tid (StatusForm newStatus) = do
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index c1ad47e..8b6a8a7 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -29,6 +29,7 @@ stylesheet = do
statusBadges
buttonStyles
formStyles
+ activityTimelineStyles
responsiveStyles
darkModeStyles
@@ -434,6 +435,96 @@ formStyles = do
fontSize (px 14)
Stylesheet.key "resize" ("vertical" :: Text)
+activityTimelineStyles :: Css
+activityTimelineStyles = do
+ ".activity-section" ? do
+ marginTop (em 1.5)
+ backgroundColor white
+ borderRadius (px 8) (px 8) (px 8) (px 8)
+ padding (px 16) (px 16) (px 16) (px 16)
+ boxShadow (NE.singleton (bsColor (rgba 0 0 0 0.1) (shadow (px 0) (px 1))))
+ ".activity-timeline" ? do
+ position relative
+ paddingLeft (px 24)
+ marginTop (px 12)
+ ".activity-timeline" # before ? do
+ Stylesheet.key "content" ("''" :: Text)
+ position absolute
+ left (px 8)
+ top (px 0)
+ bottom (px 0)
+ width (px 2)
+ backgroundColor "#e5e7eb"
+ ".activity-item" ? do
+ position relative
+ display flex
+ Stylesheet.key "gap" ("12px" :: Text)
+ paddingBottom (px 16)
+ marginBottom (px 0)
+ ".activity-item" # lastChild ? paddingBottom (px 0)
+ ".activity-icon" ? do
+ position absolute
+ left (px (-20))
+ width (px 18)
+ height (px 18)
+ borderRadius (pct 50) (pct 50) (pct 50) (pct 50)
+ display flex
+ alignItems center
+ justifyContent center
+ fontSize (px 10)
+ fontWeight bold
+ backgroundColor white
+ border (px 2) solid "#e5e7eb"
+ ".activity-content" ? do
+ Stylesheet.key "flex" ("1" :: Text)
+ ".activity-header" ? do
+ display flex
+ alignItems center
+ Stylesheet.key "gap" ("8px" :: Text)
+ marginBottom (px 4)
+ ".activity-stage" ? do
+ fontWeight (weight 600)
+ fontSize (px 14)
+ ".activity-time" ? do
+ fontSize (px 12)
+ color "#6b7280"
+ ".activity-message" ? do
+ margin (px 4) (px 0) (px 0) (px 0)
+ fontSize (px 14)
+ color "#374151"
+ ".activity-metadata" ? do
+ marginTop (px 8)
+ (".activity-metadata" |> "summary") ? do
+ fontSize (px 12)
+ color "#6b7280"
+ cursor pointer
+ ".metadata-json" ? do
+ fontSize (px 11)
+ backgroundColor "#f3f4f6"
+ padding (px 8) (px 8) (px 8) (px 8)
+ borderRadius (px 4) (px 4) (px 4) (px 4)
+ marginTop (px 4)
+ maxHeight (px 200)
+ overflow auto
+ ".stage-claiming" |> ".activity-icon" ? do
+ borderColor "#3b82f6"
+ color "#3b82f6"
+ ".stage-running" |> ".activity-icon" ? do
+ borderColor "#f59e0b"
+ color "#f59e0b"
+ ".stage-reviewing" |> ".activity-icon" ? do
+ borderColor "#8b5cf6"
+ color "#8b5cf6"
+ ".stage-retrying" |> ".activity-icon" ? do
+ borderColor "#f97316"
+ color "#f97316"
+ ".stage-completed" |> ".activity-icon" ? do
+ borderColor "#10b981"
+ color "#10b981"
+ ".stage-failed" |> ".activity-icon" ? do
+ borderColor "#ef4444"
+ color "#ef4444"
+
responsiveStyles :: Css
responsiveStyles = do
query Media.screen [Media.maxWidth (px 600)] <| do
@@ -529,6 +620,17 @@ darkModeStyles =
".stats-row" ? borderBottomColor "#374151"
".progress-bar" ? backgroundColor "#374151"
".progress-fill" ? backgroundColor "#60a5fa"
+ ".activity-section" ? do
+ backgroundColor "#1f2937"
+ boxShadow (NE.singleton (bsColor (rgba 0 0 0 0.3) (shadow (px 0) (px 2))))
+ ".activity-timeline" # before ? backgroundColor "#374151"
+ ".activity-icon" ? do
+ backgroundColor "#1f2937"
+ borderColor "#374151"
+ ".activity-time" ? color "#9ca3af"
+ ".activity-message" ? color "#d1d5db"
+ (".activity-metadata" |> "summary") ? color "#9ca3af"
+ ".metadata-json" ? backgroundColor "#374151"
prefersDark :: Stylesheet.Feature
prefersDark =
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index d9ea98c..bd70fde 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -1014,3 +1014,19 @@ logActivity tid stage metadata =
conn
"INSERT INTO task_activity (task_id, stage, message, metadata) VALUES (?, ?, ?, ?)"
(tid, show stage, Nothing :: Maybe Text, metadata)
+
+-- | Get all activities for a task, ordered by timestamp descending
+getActivitiesForTask :: Text -> IO [TaskActivity]
+getActivitiesForTask tid =
+ withDb <| \conn -> do
+ rows <-
+ SQL.query
+ conn
+ "SELECT id, task_id, timestamp, stage, message, metadata \
+ \FROM task_activity WHERE task_id = ? ORDER BY timestamp DESC"
+ (SQL.Only tid) ::
+ IO [(Int, Text, UTCTime, Text, Maybe Text, Maybe Text)]
+ pure [TaskActivity (Just i) taskId ts (readStage stg) msg meta | (i, taskId, ts, stg, msg, meta) <- rows]
+ where
+ readStage :: Text -> ActivityStage
+ readStage s = fromMaybe Claiming (readMaybe (T.unpack s))
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 19:32:51 +0000