diff options
Diffstat (limited to 'Omni/Jr')
| -rw-r--r-- | Omni/Jr/Web.hs | 91 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 48 |
2 files changed, 136 insertions, 3 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 5fc8126..55ff06b 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -93,9 +93,19 @@ newtype InterventionPage = InterventionPage [TaskCore.Task] data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters data TaskDetailPage - = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) + = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] | TaskDetailNotFound Text +data GitCommit = GitCommit + { commitHash :: Text, + commitShortHash :: Text, + commitSummary :: Text, + commitAuthor :: Text, + commitRelativeDate :: Text, + commitFilesChanged :: Int + } + deriving (Show, Eq) + data TaskReviewPage = ReviewPageFound TaskCore.Task ReviewInfo | ReviewPageNotFound Text @@ -406,7 +416,7 @@ instance Lucid.ToHtml TaskDetailPage where "The task " Lucid.code_ (Lucid.toHtml tid) " could not be found." - toHtml (TaskDetailFound task allTasks activities maybeRetry) = + toHtml (TaskDetailFound task allTasks activities maybeRetry commits) = Lucid.doctypehtml_ <| do pageHead (TaskCore.taskId task <> " - Jr") Lucid.body_ <| do @@ -496,6 +506,12 @@ instance Lucid.ToHtml TaskDetailPage where Lucid.ul_ [Lucid.class_ "child-list"] <| do traverse_ renderChild children + unless (null commits) <| do + Lucid.div_ [Lucid.class_ "detail-section"] <| do + Lucid.h3_ "Git Commits" + Lucid.div_ [Lucid.class_ "commit-list"] <| do + traverse_ (renderCommit (TaskCore.taskId task)) commits + let hasRunningActivity = any (\a -> TaskCore.activityStage a == TaskCore.Running) activities when hasRunningActivity <| do let isInProgress = TaskCore.taskStatus task == TaskCore.InProgress @@ -546,6 +562,21 @@ 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) <> "]") + renderCommit :: (Monad m) => Text -> GitCommit -> Lucid.HtmlT m () + renderCommit tid c = + Lucid.div_ [Lucid.class_ "commit-item"] <| do + Lucid.div_ [Lucid.class_ "commit-header"] <| do + Lucid.a_ + [ Lucid.href_ ("/tasks/" <> tid <> "/diff/" <> commitHash c), + Lucid.class_ "commit-hash" + ] + (Lucid.toHtml (commitShortHash c)) + Lucid.span_ [Lucid.class_ "commit-summary"] (Lucid.toHtml (commitSummary c)) + Lucid.div_ [Lucid.class_ "commit-meta"] <| do + Lucid.span_ [Lucid.class_ "commit-author"] (Lucid.toHtml (commitAuthor c)) + Lucid.span_ [Lucid.class_ "commit-date"] (Lucid.toHtml (commitRelativeDate c)) + Lucid.span_ [Lucid.class_ "commit-files"] (Lucid.toHtml (tshow (commitFilesChanged c) <> " files")) + renderActivity :: (Monad m) => TaskCore.TaskActivity -> Lucid.HtmlT m () renderActivity act = Lucid.div_ [Lucid.class_ ("activity-item " <> stageClass (TaskCore.activityStage act))] <| do @@ -1136,7 +1167,8 @@ server = Just task -> do activities <- liftIO (TaskCore.getActivitiesForTask tid) retryCtx <- liftIO (TaskCore.getRetryContext tid) - pure (TaskDetailFound task tasks activities retryCtx) + commits <- liftIO (getCommitsForTask tid) + pure (TaskDetailFound task tasks activities retryCtx commits) taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial taskStatusHandler tid (StatusForm newStatus) = do @@ -1241,6 +1273,59 @@ findCommitForTask tid = do (x : _) -> pure (Just (Text.pack x)) [] -> pure Nothing +getCommitsForTask :: Text -> IO [GitCommit] +getCommitsForTask tid = do + let grepArg = "--grep=Task-Id: " <> Text.unpack tid + (code, out, _) <- + Process.readProcessWithExitCode + "git" + ["log", "--pretty=format:%H|%h|%s|%an|%ar", grepArg] + "" + if code /= Exit.ExitSuccess || null out + then pure [] + else do + let commitLines = filter (not <. null) (List.lines out) + traverse parseCommitLine commitLines + where + parseCommitLine :: String -> IO GitCommit + parseCommitLine line = + case Text.splitOn "|" (Text.pack line) of + [sha, shortSha, summary, author, relDate] -> do + filesCount <- getFilesChangedCount (Text.unpack sha) + pure + GitCommit + { commitHash = sha, + commitShortHash = shortSha, + commitSummary = summary, + commitAuthor = author, + commitRelativeDate = relDate, + commitFilesChanged = filesCount + } + _ -> + pure + GitCommit + { commitHash = Text.pack line, + commitShortHash = Text.take 7 (Text.pack line), + commitSummary = "(parse error)", + commitAuthor = "", + commitRelativeDate = "", + commitFilesChanged = 0 + } + + getFilesChangedCount :: String -> IO Int + getFilesChangedCount sha = do + (code', out', _) <- + Process.readProcessWithExitCode + "git" + ["show", "--stat", "--format=", sha] + "" + pure + <| if code' /= Exit.ExitSuccess + then 0 + else + let statLines = filter (not <. null) (List.lines out') + in max 0 (length statLines - 1) + checkMergeConflict :: String -> IO (Maybe [Text]) checkMergeConflict commitSha = do (_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] "" diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index b4f4c76..19fc371 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -30,6 +30,7 @@ stylesheet = do formStyles executionDetailsStyles activityTimelineStyles + commitStyles markdownStyles responsiveStyles darkModeStyles @@ -621,6 +622,45 @@ activityTimelineStyles = do borderColor "#ef4444" color "#ef4444" +commitStyles :: Css +commitStyles = do + ".commit-list" ? do + display flex + flexDirection column + Stylesheet.key "gap" ("4px" :: Text) + marginTop (px 8) + ".commit-item" ? do + padding (px 6) (px 8) (px 6) (px 8) + backgroundColor "#f9fafb" + borderRadius (px 2) (px 2) (px 2) (px 2) + border (px 1) solid "#e5e7eb" + ".commit-header" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + marginBottom (px 2) + ".commit-hash" ? do + fontFamily ["SF Mono", "Monaco", "monospace"] [monospace] + fontSize (px 12) + color "#0066cc" + textDecoration none + backgroundColor "#e5e7eb" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + ".commit-hash" # hover ? textDecoration underline + ".commit-summary" ? do + fontSize (px 13) + color "#374151" + fontWeight (weight 500) + ".commit-meta" ? do + display flex + Stylesheet.key "gap" ("12px" :: Text) + fontSize (px 11) + color "#6b7280" + ".commit-author" ? fontWeight (weight 500) + ".commit-files" ? do + color "#9ca3af" + markdownStyles :: Css markdownStyles = do ".markdown-content" ? do @@ -793,6 +833,14 @@ darkModeStyles = ".metric-value" ? color "#d1d5db" ".amp-link" ? color "#60a5fa" ".markdown-content" ? color "#d1d5db" + ".commit-item" ? do + backgroundColor "#374151" + borderColor "#4b5563" + ".commit-hash" ? do + backgroundColor "#4b5563" + color "#60a5fa" + ".commit-summary" ? color "#d1d5db" + ".commit-meta" ? color "#9ca3af" ".md-h1" ? borderBottomColor "#374151" ".md-inline-code" ? do backgroundColor "#374151" |