More work on timeline rendering

Author: thomasjm

app/Sauron/UI/Event.hs

@@ -46,8 +46,6 @@ getEventIcon eventType = case eventType of
   HeadRefForcePushed -> "↑"
   HeadRefRestored -> "↪"
   CrossReferenced -> "&"
-  Committed -> "●"
-  Reviewed -> "✓"
   Unknown _ -> "?"
 
 -- | Get a colored icon widget for an event type using GitHub's color scheme
@@ -91,8 +89,6 @@ getEventColorAttr eventType = case eventType of
   HeadRefForcePushed -> eventRefDeletedColor
   HeadRefRestored -> eventRefRestoredColor
   CrossReferenced -> eventReferencedColor
-  Committed -> eventReferencedColor
-  Reviewed -> eventReviewColor
   Unknown _ -> eventRefRestoredColor
 
 getEventDescription :: EventType -> String
@@ -130,6 +126,4 @@ getEventDescription eventType = case eventType of
   HeadRefForcePushed -> "force-pushed the head branch"
   HeadRefRestored -> "restored the head branch"
   CrossReferenced -> "referenced this"
-  Committed -> "added a commit"
-  Reviewed -> "reviewed this"
   Unknown t -> [i|#{t} (unknown event type)|]

app/Sauron/UI/Issue.hs

@@ -183,6 +183,8 @@ renderItemWithBorder now isLast borderFunc item =
   case item of
     SingleItem (TimelineComment comment) -> renderComment now borderFunc comment
     SingleItem (TimelineIssueEvent event) -> renderEvent now isLast event
+    SingleItem (TimelineCommit commit) -> renderCommitEvent now isLast commit
+    SingleItem (TimelineReview review) -> renderReviewEvent now isLast review
     LabelGroup rep added removed -> renderLabelGroup now isLast rep added removed
     ReviewRequestGroup rep events -> renderReviewRequestGroup now isLast rep events
 

app/Sauron/UI/Issue/Events.hs

@@ -7,6 +7,8 @@ module Sauron.UI.Issue.Events (
 
   -- * Rendering
   , renderEvent
+  , renderCommitEvent
+  , renderReviewEvent
   , renderLabelGroup
   , labelPill
 
@@ -65,12 +67,14 @@ adaptiveWidth f = Widget Greedy Fixed $ do
 consolidateEvents :: [TimelineEvent] -> [TimelineItem]
 consolidateEvents [] = []
 consolidateEvents (TimelineComment c : rest) = SingleItem (TimelineComment c) : consolidateEvents rest
+consolidateEvents (TimelineCommit c : rest) = SingleItem (TimelineCommit c) : consolidateEvents rest
+consolidateEvents (TimelineReview r : rest) = SingleItem (TimelineReview r) : consolidateEvents rest
 consolidateEvents (TimelineIssueEvent e : rest)
   | isLabelEvent e =
       let (run, remaining) = span (isMatchingEvent isLabelEvent e) rest
           events = e : [ev | TimelineIssueEvent ev <- run]
-          added = filter (\ev -> issueEventType ev == Labeled) events
-          removed = filter (\ev -> issueEventType ev == Unlabeled) events
+          added = filter (\ev -> issueEventEvent ev == Labeled) events
+          removed = filter (\ev -> issueEventEvent ev == Unlabeled) events
       in if length events > 1
          then LabelGroup e added removed : consolidateEvents remaining
          else SingleItem (TimelineIssueEvent e) : consolidateEvents rest
@@ -90,10 +94,10 @@ isMatchingEvent predicate ref (TimelineIssueEvent ev) =
 isMatchingEvent _ _ _ = False
 
 isLabelEvent :: IssueEvent -> Bool
-isLabelEvent e = issueEventType e `elem` [Labeled, Unlabeled]
+isLabelEvent e = issueEventEvent e `elem` [Labeled, Unlabeled]
 
 isReviewRequestEvent :: IssueEvent -> Bool
-isReviewRequestEvent e = issueEventType e == ReviewRequested
+isReviewRequestEvent e = issueEventEvent e == ReviewRequested
 
 
 -- * Rendering
@@ -102,10 +106,10 @@ renderEvent :: UTCTime -> Bool -> IssueEvent -> Widget n
 renderEvent now isLast issueEvent =
   let actorName :: Text = case issueEventActor issueEvent of
         Just (SimpleUser {simpleUserLogin=(N username)}) -> username
-        Nothing -> fromMaybe "ghost" (issueEventAuthorName issueEvent)
+        Nothing -> "ghost"
       -- Each sized item is (width, widget)
       eventSuffixItems :: [(Int, Widget n)]
-      eventSuffixItems = case issueEventType issueEvent of
+      eventSuffixItems = case issueEventEvent issueEvent of
         Labeled -> case issueEventLabel issueEvent of
           Just (IssueLabel {labelName=(N name), labelColor=hexColor}) -> [(5, str " the "), (safeWctwidth name + 2, labelPill hexColor name), (7, str " label")]
           Nothing -> [(8, str " a label")]
@@ -115,23 +119,20 @@ renderEvent now isLast issueEvent =
         Referenced -> case issueEventCommitId issueEvent of
           Just sha -> let short = T.take 7 sha in [(11, str " in commit "), (safeWctwidth short, withAttr hashAttr (str (toString short)))]
           Nothing -> []
-        CrossReferenced -> case issueEventSourceIssue issueEvent of
+        CrossReferenced -> case issueEventSource issueEvent >>= crossReferenceSourceIssue of
           Just sourceIssue ->
             let num = show (unIssueNumber (issueNumber sourceIssue))
                 ref = "#" <> num
                 title = toString (issueTitle sourceIssue)
                 quoted = "\"" <> title <> "\""
             in [(5, str " from "), (safeWcswidth ref, withAttr hashNumberAttr (str ref)), (1 + safeWcswidth quoted, str " " <+> withAttr normalAttr (str quoted))]
           Nothing -> []
-        Committed -> case issueEventCommitId issueEvent of
-          Just sha -> let short = T.take 7 sha in [(1 + safeWctwidth short, str " " <+> withAttr hashAttr (str (toString short)))]
-          Nothing -> []
         ReviewRequested -> case issueEventRequestedReviewer issueEvent of
           Just (SimpleUser {simpleUserLogin=(N reviewer)}) -> [(1 + safeWctwidth reviewer, str " " <+> withAttr usernameAttr (str (toString reviewer)))]
           Nothing -> []
         _ -> []
-      eventText = getEventDescription (issueEventType issueEvent)
-      iconWidget = getEventIconWithColor (issueEventType issueEvent)
+      eventText = getEventDescription (issueEventEvent issueEvent)
+      iconWidget = getEventIconWithColor (issueEventEvent issueEvent)
       timeAgo = timeFromNow (diffUTCTime now (issueEventCreatedAt issueEvent))
       timeAgoWidget = (safeWcswidth timeAgo, withAttr italicText $ str timeAgo)
       descriptionItems = [(safeWcswidth eventText, str eventText)] ++ eventSuffixItems ++ [(1, str " "), timeAgoWidget]
@@ -152,13 +153,64 @@ renderEvent now isLast issueEvent =
         else adaptiveWidth $ \_ -> padLeft (Pad 4) $ withAttr timelineBorderAttr $ str "│"
   in vBox [eventLine, continuationLine]
 
+renderCommitEvent :: UTCTime -> Bool -> TimelineCommitEvent -> Widget n
+renderCommitEvent now isLast commit =
+  let actorName = gitAuthorName (timelineCommitEventAuthor commit)
+      short = T.take 7 (timelineCommitEventSha commit)
+      timeAgo = timeFromNow (diffUTCTime now (gitAuthorDate (timelineCommitEventAuthor commit)))
+      firstMsgLine = T.takeWhile (/= '\n') (timelineCommitEventMessage commit)
+      iconWidget = withAttr eventReferencedColor (str "●")
+      descriptionItems =
+        [(16, str "added a commit "), (safeWctwidth short, withAttr hashAttr (str (toString short))), (1, str " "), (safeWcswidth timeAgo, withAttr italicText $ str timeAgo)]
+      prefixWidth = 1 + 2 + safeWctwidth actorName + 1
+      eventLine = adaptiveWidth $ \w ->
+        let availableWidth = w - 4
+            wrappedLines = wrapWidgets (availableWidth - prefixWidth) descriptionItems
+            prefix = hBox [iconWidget, str "  ", withAttr usernameAttr $ str (toString actorName), str " "]
+            firstLine = case wrappedLines of
+              [] -> prefix
+              (l:_) -> hBox [prefix, hBox (map snd l)]
+            restLines = case wrappedLines of
+              [] -> []
+              (_:ls) -> [padLeft (Pad 3) $ hBox (map snd l) | l <- ls]
+            msgLine = padLeft (Pad 3) $ hLimit (w - 4 - 3) $ withAttr normalAttr $ str (toString firstMsgLine)
+        in padLeft (Pad 4) $ vBox (firstLine : restLines ++ [msgLine])
+      continuationLine = if isLast
+        then emptyWidget
+        else adaptiveWidth $ \_ -> padLeft (Pad 4) $ withAttr timelineBorderAttr $ str "│"
+  in vBox [eventLine, continuationLine]
+
+renderReviewEvent :: UTCTime -> Bool -> TimelineReviewEvent -> Widget n
+renderReviewEvent now isLast review =
+  let actorName = case timelineReviewEventUser review of
+        SimpleUser {simpleUserLogin=(N username)} -> username
+      timeAgo = timeFromNow (diffUTCTime now (timelineReviewEventSubmittedAt review))
+      iconWidget = withAttr eventReviewColor (str "✓")
+      descriptionItems = [(13, str "reviewed this "), (safeWcswidth timeAgo, withAttr italicText $ str timeAgo)]
+      prefixWidth = 1 + 2 + safeWctwidth actorName + 1
+      eventLine = adaptiveWidth $ \w ->
+        let availableWidth = w - 4
+            wrappedLines = wrapWidgets (availableWidth - prefixWidth) descriptionItems
+            prefix = hBox [iconWidget, str "  ", withAttr usernameAttr $ str (toString actorName), str " "]
+            firstLine = case wrappedLines of
+              [] -> prefix
+              (l:_) -> hBox [prefix, hBox (map snd l)]
+            restLines = case wrappedLines of
+              [] -> []
+              (_:ls) -> [padLeft (Pad 3) $ hBox (map snd l) | l <- ls]
+        in padLeft (Pad 4) $ vBox (firstLine : restLines)
+      continuationLine = if isLast
+        then emptyWidget
+        else adaptiveWidth $ \_ -> padLeft (Pad 4) $ withAttr timelineBorderAttr $ str "│"
+  in vBox [eventLine, continuationLine]
+
 renderLabelGroup :: UTCTime -> Bool -> IssueEvent -> [IssueEvent] -> [IssueEvent] -> Widget n
 renderLabelGroup now isLast rep added removed =
   let actorName :: Text = case issueEventActor rep of
         Just (SimpleUser {simpleUserLogin=(N username)}) -> username
         Nothing -> "ghost"
       timeAgo = timeFromNow (diffUTCTime now (issueEventCreatedAt rep))
-      iconWidget = getEventIconWithColor (issueEventType rep)
+      iconWidget = getEventIconWithColor (issueEventEvent rep)
       addedItems = mapMaybe eventLabelPillWithWidth added
       removedItems = mapMaybe eventLabelPillWithWidth removed
       totalLabels = length added + length removed

app/Sauron/UI/Issue/Events/ReviewRequests.hs

@@ -21,7 +21,7 @@ renderReviewRequestGroup now isLast rep events =
         Just (SimpleUser {simpleUserLogin=(N username)}) -> username
         Nothing -> "ghost"
       timeAgo = timeFromNow (diffUTCTime now (issueEventCreatedAt rep))
-      iconWidget = getEventIconWithColor (issueEventType rep)
+      iconWidget = getEventIconWithColor (issueEventEvent rep)
       reviewerNames = mapMaybe (\e -> case issueEventRequestedReviewer e of
         Just (SimpleUser {simpleUserLogin=(N name)}) -> Just name
         Nothing -> Nothing) events

stack.yaml

@@ -13,6 +13,7 @@ extra-deps:
 - vty-windows-0.2.0.3
 - brick-skylighting-1.0@sha256:64764b6be36c05261959f68ed38b9cb37e1acb6180a3bde5dd98255f62ea7e3b,1812
 
+# - /home/tom/tools/github
 - git: https://github.com/codedownio/github.git
   # sauron-sep18-2025 branch, which has some changes from upstream:
   # - fixes for search query escaping
@@ -30,7 +31,9 @@ extra-deps:
   # - issueEventActor: switch to a Maybe
   # - Add HeadRefForcePushed event type
   # - Add /issues/timeline API support
-  commit: 3d100995c86b5b574b50f68e6d6f430290f3cee2
+  # - Parse issue event message
+  # - GitHub.Data.Issues: auto-derive JSON instances
+  commit: 4fd5d4525dca35f2e54aea76f4665b97e951ab3a
 
 - git: https://github.com/dogonthehorizon/git-config.git
   commit: 8f3fab100e4c8d82b5c6fe7c0cc09510249e98cf

stack.yaml.lock

@@ -18,17 +18,6 @@ packages:
       size: 393
   original:
     hackage: brick-skylighting-1.0@sha256:64764b6be36c05261959f68ed38b9cb37e1acb6180a3bde5dd98255f62ea7e3b,1812
-- completed:
-    commit: 3d100995c86b5b574b50f68e6d6f430290f3cee2
-    git: https://github.com/codedownio/github.git
-    name: github
-    pantry-tree:
-      sha256: d7bfef8770965b6a32b9a87bef4531f8a8fe35a6dd9f31f38fa879d62d147838
-      size: 19445
-    version: 0.30.0.1
-  original:
-    commit: 3d100995c86b5b574b50f68e6d6f430290f3cee2
-    git: https://github.com/codedownio/github.git
 - completed:
     commit: 8f3fab100e4c8d82b5c6fe7c0cc09510249e98cf
     git: https://github.com/dogonthehorizon/git-config.git