path: root/Omni/Jr/Web/Handlers.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- : dep warp
-- : dep servant-server
-- : dep lucid
-- : dep servant-lucid
-- : dep process
-- : dep aeson
module Omni.Jr.Web.Handlers
  ( API,
    server,
    api,
    streamAgentEvents,
  )
where

import Alpha
import qualified Control.Concurrent as Concurrent
import qualified Data.Aeson as Aeson
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import Data.Time (getCurrentTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import qualified Omni.Fact as Fact
import qualified Omni.Jr.Web.Style as Style
import Omni.Jr.Web.Types
import qualified Omni.Task.Core as TaskCore
import Servant
import qualified Servant.HTML.Lucid as Lucid
import qualified Servant.Types.SourceT as Source
import qualified System.Exit as Exit
import qualified System.Process as Process

type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent)

type API =
  QueryParam "range" Text :> Get '[Lucid.HTML] HomePage
    :<|> "style.css" :> Get '[CSS] LazyText.Text
    :<|> "ready" :> QueryParam "sort" Text :> Get '[Lucid.HTML] ReadyQueuePage
    :<|> "blocked" :> QueryParam "sort" Text :> Get '[Lucid.HTML] BlockedPage
    :<|> "intervention" :> QueryParam "sort" Text :> Get '[Lucid.HTML] InterventionPage
    :<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage
    :<|> "tasks"
      :> QueryParam "status" Text
      :> QueryParam "priority" Text
      :> QueryParam "namespace" Text
      :> QueryParam "type" Text
      :> QueryParam "sort" Text
      :> Get '[Lucid.HTML] TaskListPage
    :<|> "kb" :> Get '[Lucid.HTML] KBPage
    :<|> "kb" :> "create" :> ReqBody '[FormUrlEncoded] FactCreateForm :> PostRedirect
    :<|> "kb" :> Capture "id" Int :> Get '[Lucid.HTML] FactDetailPage
    :<|> "kb" :> Capture "id" Int :> "edit" :> ReqBody '[FormUrlEncoded] FactEditForm :> PostRedirect
    :<|> "kb" :> Capture "id" Int :> "delete" :> PostRedirect
    :<|> "epics" :> QueryParam "sort" Text :> Get '[Lucid.HTML] EpicsPage
    :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
    :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
    :<|> "tasks" :> Capture "id" Text :> "priority" :> ReqBody '[FormUrlEncoded] PriorityForm :> Post '[Lucid.HTML] PriorityBadgePartial
    :<|> "tasks" :> Capture "id" Text :> "complexity" :> ReqBody '[FormUrlEncoded] ComplexityForm :> Post '[Lucid.HTML] ComplexityBadgePartial
    :<|> "tasks" :> Capture "id" Text :> "description" :> "view" :> Get '[Lucid.HTML] DescriptionViewPartial
    :<|> "tasks" :> Capture "id" Text :> "description" :> "edit" :> Get '[Lucid.HTML] DescriptionEditPartial
    :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> Post '[Lucid.HTML] DescriptionViewPartial
    :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect
    :<|> "tasks" :> Capture "id" Text :> "comment" :> ReqBody '[FormUrlEncoded] CommentForm :> PostRedirect
    :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
    :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage
    :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect
    :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect
    :<|> "tasks" :> Capture "id" Text :> "reset-retries" :> PostRedirect
    :<|> "partials" :> "recent-activity-new" :> QueryParam "since" Int :> Get '[Lucid.HTML] RecentActivityNewPartial
    :<|> "partials" :> "recent-activity-more" :> QueryParam "offset" Int :> Get '[Lucid.HTML] RecentActivityMorePartial
    :<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial
    :<|> "partials"
      :> "task-list"
      :> QueryParam "status" Text
      :> QueryParam "priority" Text
      :> QueryParam "namespace" Text
      :> QueryParam "type" Text
      :> QueryParam "sort" Text
      :> Get '[Lucid.HTML] TaskListPartial
    :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
    :<|> "partials" :> "task" :> Capture "id" Text :> "events" :> QueryParam "since" Int :> Get '[Lucid.HTML] AgentEventsPartial
    :<|> "tasks" :> Capture "id" Text :> "events" :> "stream" :> StreamGet NoFraming SSE (SourceIO ByteString)

api :: Proxy API
api = Proxy

server :: Server API
server =
  homeHandler
    :<|> styleHandler
    :<|> readyQueueHandler
    :<|> blockedHandler
    :<|> interventionHandler
    :<|> statsHandler
    :<|> taskListHandler
    :<|> kbHandler
    :<|> factCreateHandler
    :<|> factDetailHandler
    :<|> factEditHandler
    :<|> factDeleteHandler
    :<|> epicsHandler
    :<|> taskDetailHandler
    :<|> taskStatusHandler
    :<|> taskPriorityHandler
    :<|> taskComplexityHandler
    :<|> descriptionViewHandler
    :<|> descriptionEditHandler
    :<|> descriptionPostHandler
    :<|> taskNotesHandler
    :<|> taskCommentHandler
    :<|> taskReviewHandler
    :<|> taskDiffHandler
    :<|> taskAcceptHandler
    :<|> taskRejectHandler
    :<|> taskResetRetriesHandler
    :<|> recentActivityNewHandler
    :<|> recentActivityMoreHandler
    :<|> readyCountHandler
    :<|> taskListPartialHandler
    :<|> taskMetricsPartialHandler
    :<|> agentEventsPartialHandler
    :<|> taskEventsStreamHandler
  where
    styleHandler :: Servant.Handler LazyText.Text
    styleHandler = pure Style.css

    homeHandler :: Maybe Text -> Servant.Handler HomePage
    homeHandler maybeRangeText = do
      now <- liftIO getCurrentTime
      let range = parseTimeRange maybeRangeText
          maybeStart = getTimeRangeStart range now
      allTasks <- liftIO TaskCore.loadTasks
      let filteredTasks = case maybeStart of
            Nothing -> allTasks
            Just start -> [t | t <- allTasks, TaskCore.taskUpdatedAt t >= start]
          stats = TaskCore.computeTaskStatsFromList filteredTasks
      readyTasks <- liftIO TaskCore.getReadyTasks
      allActivities <- liftIO <| concat </ traverse (TaskCore.getActivitiesForTask <. TaskCore.taskId) allTasks
      let filteredActivities = case maybeStart of
            Nothing -> allActivities
            Just start -> [a | a <- allActivities, TaskCore.activityTimestamp a >= start]
          globalMetrics = computeMetricsFromActivities filteredTasks filteredActivities
          sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) filteredTasks
          recentTasks = take 5 sortedTasks
          hasMoreRecent = length filteredTasks > 5
      pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics range now)

    readyQueueHandler :: Maybe Text -> Servant.Handler ReadyQueuePage
    readyQueueHandler maybeSortText = do
      now <- liftIO getCurrentTime
      readyTasks <- liftIO TaskCore.getReadyTasks
      let sortOrder = parseSortOrder maybeSortText
          sortedTasks = sortTasks sortOrder readyTasks
      pure (ReadyQueuePage sortedTasks sortOrder now)

    blockedHandler :: Maybe Text -> Servant.Handler BlockedPage
    blockedHandler maybeSortText = do
      now <- liftIO getCurrentTime
      blockedTasks <- liftIO TaskCore.getBlockedTasks
      allTasks <- liftIO TaskCore.loadTasks
      let sortOrder = parseSortOrder maybeSortText
          tasksWithImpact = [(t, TaskCore.getBlockingImpact allTasks t) | t <- blockedTasks]
          sorted = List.sortBy (comparing (Down <. snd)) tasksWithImpact
      pure (BlockedPage sorted sortOrder now)

    interventionHandler :: Maybe Text -> Servant.Handler InterventionPage
    interventionHandler maybeSortText = do
      now <- liftIO getCurrentTime
      actionItems <- liftIO TaskCore.getHumanActionItems
      let sortOrder = parseSortOrder maybeSortText
      pure (InterventionPage actionItems sortOrder now)

    statsHandler :: Maybe Text -> Servant.Handler StatsPage
    statsHandler maybeEpic = do
      let epicId = emptyToNothing maybeEpic
      stats <- liftIO <| TaskCore.getTaskStats epicId
      pure (StatsPage stats epicId)

    taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
    taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do
      now <- liftIO getCurrentTime
      allTasks <- liftIO TaskCore.loadTasks
      let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
          maybePriority = parsePriority =<< emptyToNothing maybePriorityText
          maybeType = parseTaskType =<< emptyToNothing maybeTypeText
          filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
          sortOrder = parseSortOrder maybeSortText
          filteredTasks = sortTasks sortOrder (applyFilters filters allTasks)
      pure (TaskListPage filteredTasks filters sortOrder now)

    kbHandler :: Servant.Handler KBPage
    kbHandler = do
      facts <- liftIO Fact.getAllFacts
      pure (KBPage facts)

    factCreateHandler :: FactCreateForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    factCreateHandler (FactCreateForm project content filesText confText) = do
      let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText))
          confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText))
      fid <- liftIO (Fact.createFact project content files Nothing confidence)
      pure <| addHeader ("/kb/" <> tshow fid) NoContent

    factDetailHandler :: Int -> Servant.Handler FactDetailPage
    factDetailHandler fid = do
      now <- liftIO getCurrentTime
      maybeFact <- liftIO (Fact.getFact fid)
      case maybeFact of
        Nothing -> pure (FactDetailNotFound fid)
        Just fact -> pure (FactDetailFound fact now)

    factEditHandler :: Int -> FactEditForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    factEditHandler fid (FactEditForm content filesText confText) = do
      let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText))
          confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText))
      liftIO (Fact.updateFact fid content files confidence)
      pure <| addHeader ("/kb/" <> tshow fid) NoContent

    factDeleteHandler :: Int -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    factDeleteHandler fid = do
      liftIO (Fact.deleteFact fid)
      pure <| addHeader "/kb" NoContent

    epicsHandler :: Maybe Text -> Servant.Handler EpicsPage
    epicsHandler maybeSortText = do
      allTasks <- liftIO TaskCore.loadTasks
      let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks
          sortOrder = parseSortOrder maybeSortText
          sortedEpics = sortTasks sortOrder epicTasks
      pure (EpicsPage sortedEpics allTasks sortOrder)

    parseStatus :: Text -> Maybe TaskCore.Status
    parseStatus = readMaybe <. Text.unpack

    parsePriority :: Text -> Maybe TaskCore.Priority
    parsePriority = readMaybe <. Text.unpack

    parseTaskType :: Text -> Maybe TaskCore.TaskType
    parseTaskType = readMaybe <. Text.unpack

    emptyToNothing :: Maybe Text -> Maybe Text
    emptyToNothing (Just t) | Text.null (Text.strip t) = Nothing
    emptyToNothing x = x

    applyFilters :: TaskFilters -> [TaskCore.Task] -> [TaskCore.Task]
    applyFilters filters = filter matchesAllFilters
      where
        matchesAllFilters task =
          matchesStatus task
            && matchesPriority task
            && matchesNamespace task
            && matchesType task

        matchesStatus task = case filterStatus filters of
          Nothing -> True
          Just s -> TaskCore.taskStatus task == s

        matchesPriority task = case filterPriority filters of
          Nothing -> True
          Just p -> TaskCore.taskPriority task == p

        matchesNamespace task = case filterNamespace filters of
          Nothing -> True
          Just ns -> case TaskCore.taskNamespace task of
            Nothing -> False
            Just taskNs -> ns `Text.isPrefixOf` taskNs

        matchesType task = case filterType filters of
          Nothing -> True
          Just t -> TaskCore.taskType task == t

    taskDetailHandler :: Text -> Servant.Handler TaskDetailPage
    taskDetailHandler tid = do
      now <- liftIO getCurrentTime
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> pure (TaskDetailNotFound tid)
        Just task -> do
          activities <- liftIO (TaskCore.getActivitiesForTask tid)
          retryCtx <- liftIO (TaskCore.getRetryContext tid)
          commits <- liftIO (getCommitsForTask tid)
          aggMetrics <-
            if TaskCore.taskType task == TaskCore.Epic
              then Just </ liftIO (TaskCore.getAggregatedMetrics tid)
              else pure Nothing
          agentEvents <- liftIO (TaskCore.getAllEventsForTask tid)
          pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics agentEvents now)

    taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
    taskStatusHandler tid (StatusForm newStatus) = do
      liftIO <| TaskCore.updateTaskStatusWithActor tid newStatus [] TaskCore.Human
      pure (StatusBadgePartial newStatus tid)

    taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial
    taskPriorityHandler tid (PriorityForm newPriority) = do
      _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskPriority = newPriority})
      pure (PriorityBadgePartial newPriority tid)

    taskComplexityHandler :: Text -> ComplexityForm -> Servant.Handler ComplexityBadgePartial
    taskComplexityHandler tid (ComplexityForm newComplexity) = do
      _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskComplexity = newComplexity})
      pure (ComplexityBadgePartial newComplexity tid)

    descriptionViewHandler :: Text -> Servant.Handler DescriptionViewPartial
    descriptionViewHandler tid = do
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> throwError err404
        Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))

    descriptionEditHandler :: Text -> Servant.Handler DescriptionEditPartial
    descriptionEditHandler tid = do
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> throwError err404
        Just task -> pure (DescriptionEditPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))

    descriptionPostHandler :: Text -> DescriptionForm -> Servant.Handler DescriptionViewPartial
    descriptionPostHandler tid (DescriptionForm desc) = do
      let descText = Text.strip desc
      _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descText})
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> throwError err404
        Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))

    taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskNotesHandler tid (NotesForm notes) = do
      liftIO <| TaskCore.updateRetryNotes tid notes
      pure <| addHeader ("/tasks/" <> tid) NoContent

    taskCommentHandler :: Text -> CommentForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskCommentHandler tid (CommentForm commentText) = do
      _ <- liftIO (TaskCore.addComment tid commentText TaskCore.Human)
      pure <| addHeader ("/tasks/" <> tid) NoContent

    taskReviewHandler :: Text -> Servant.Handler TaskReviewPage
    taskReviewHandler tid = do
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> pure (ReviewPageNotFound tid)
        Just task -> do
          reviewInfo <- liftIO <| getReviewInfo tid
          pure (ReviewPageFound task reviewInfo)

    taskDiffHandler :: Text -> Text -> Servant.Handler TaskDiffPage
    taskDiffHandler tid commitSha = do
      diffOutput <- liftIO <| getDiffForCommit commitSha
      case diffOutput of
        Nothing -> pure (DiffPageNotFound tid commitSha)
        Just output -> pure (DiffPageFound tid commitSha output)

    taskAcceptHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskAcceptHandler tid = do
      liftIO <| do
        TaskCore.clearRetryContext tid
        TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.Human
      pure <| addHeader ("/tasks/" <> tid) NoContent

    taskRejectHandler :: Text -> RejectForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskRejectHandler tid (RejectForm maybeNotes) = do
      liftIO <| do
        maybeCommit <- findCommitForTask tid
        let commitSha = fromMaybe "" maybeCommit
        maybeCtx <- TaskCore.getRetryContext tid
        let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
        let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> fromMaybe "(no notes)" maybeNotes
        let accumulatedReason = case maybeCtx of
              Nothing -> currentReason
              Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
        TaskCore.setRetryContext
          TaskCore.RetryContext
            { TaskCore.retryTaskId = tid,
              TaskCore.retryOriginalCommit = commitSha,
              TaskCore.retryConflictFiles = [],
              TaskCore.retryAttempt = attempt,
              TaskCore.retryReason = accumulatedReason,
              TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
            }
        TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human
      pure <| addHeader ("/tasks/" <> tid) NoContent

    taskResetRetriesHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskResetRetriesHandler tid = do
      liftIO <| do
        TaskCore.clearRetryContext tid
        TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human
      pure <| addHeader ("/tasks/" <> tid) NoContent

    recentActivityNewHandler :: Maybe Int -> Servant.Handler RecentActivityNewPartial
    recentActivityNewHandler maybeSince = do
      allTasks <- liftIO TaskCore.loadTasks
      let sinceTime = maybe (posixSecondsToUTCTime 0) (posixSecondsToUTCTime <. fromIntegral) maybeSince
          sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks
          newTasks = filter (\t -> TaskCore.taskUpdatedAt t > sinceTime) sortedTasks
          newestTs = maybe maybeSince (Just <. taskToUnixTs) (head newTasks)
      pure (RecentActivityNewPartial newTasks newestTs)

    recentActivityMoreHandler :: Maybe Int -> Servant.Handler RecentActivityMorePartial
    recentActivityMoreHandler maybeOffset = do
      allTasks <- liftIO TaskCore.loadTasks
      let offset = fromMaybe 0 maybeOffset
          pageSize = 5
          sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks
          pageTasks = take pageSize <| drop offset sortedTasks
          hasMore = length sortedTasks > offset + pageSize
          nextOffset = offset + pageSize
      pure (RecentActivityMorePartial pageTasks nextOffset hasMore)

    readyCountHandler :: Servant.Handler ReadyCountPartial
    readyCountHandler = do
      readyTasks <- liftIO TaskCore.getReadyTasks
      pure (ReadyCountPartial (length readyTasks))

    taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
    taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do
      allTasks <- liftIO TaskCore.loadTasks
      let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
          maybePriority = parsePriority =<< emptyToNothing maybePriorityText
          maybeType = parseTaskType =<< emptyToNothing maybeTypeText
          filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
          sortOrder = parseSortOrder maybeSortText
          filteredTasks = sortTasks sortOrder (applyFilters filters allTasks)
      pure (TaskListPartial filteredTasks)

    taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial
    taskMetricsPartialHandler tid = do
      now <- liftIO getCurrentTime
      activities <- liftIO (TaskCore.getActivitiesForTask tid)
      maybeRetry <- liftIO (TaskCore.getRetryContext tid)
      pure (TaskMetricsPartial tid activities maybeRetry now)

    agentEventsPartialHandler :: Text -> Maybe Int -> Servant.Handler AgentEventsPartial
    agentEventsPartialHandler tid _maybeSince = do
      now <- liftIO getCurrentTime
      events <- liftIO (TaskCore.getAllEventsForTask tid)
      tasks <- liftIO TaskCore.loadTasks
      let isInProgress = case TaskCore.findTask tid tasks of
            Nothing -> False
            Just task -> TaskCore.taskStatus task == TaskCore.InProgress
      pure (AgentEventsPartial tid events isInProgress now)

    taskEventsStreamHandler :: Text -> Servant.Handler (SourceIO ByteString)
    taskEventsStreamHandler tid = do
      maybeSession <- liftIO (TaskCore.getLatestSessionForTask tid)
      case maybeSession of
        Nothing -> pure (Source.source [])
        Just sid -> liftIO (streamAgentEvents tid sid)

streamAgentEvents :: Text -> Text -> IO (SourceIO ByteString)
streamAgentEvents tid sid = do
  existingEvents <- TaskCore.getEventsForSession sid
  let lastId = if null existingEvents then 0 else maximum (map TaskCore.storedEventId existingEvents)
  let existingSSE = map eventToSSE existingEvents
  pure <| Source.fromStepT <| streamEventsStep tid sid lastId existingSSE True

streamEventsStep :: Text -> Text -> Int -> [ByteString] -> Bool -> Source.StepT IO ByteString
streamEventsStep tid sid lastId buffer sendExisting = case (sendExisting, buffer) of
  (True, b : bs) -> Source.Yield b (streamEventsStep tid sid lastId bs True)
  (True, []) -> streamEventsStep tid sid lastId [] False
  (False, _) ->
    Source.Effect <| do
      tasks <- TaskCore.loadTasks
      let isComplete = case TaskCore.findTask tid tasks of
            Nothing -> True
            Just task -> TaskCore.taskStatus task /= TaskCore.InProgress

      if isComplete
        then do
          let completeSSE = formatSSE "complete" "{}"
          pure <| Source.Yield completeSSE Source.Stop
        else do
          Concurrent.threadDelay 500000
          newEvents <- TaskCore.getEventsSince sid lastId
          if null newEvents
            then pure <| streamEventsStep tid sid lastId [] False
            else do
              let newLastId = maximum (map TaskCore.storedEventId newEvents)
              let newSSE = map eventToSSE newEvents
              case newSSE of
                (e : es) -> pure <| Source.Yield e (streamEventsStep tid sid newLastId es False)
                [] -> pure <| streamEventsStep tid sid newLastId [] False

eventToSSE :: TaskCore.StoredEvent -> ByteString
eventToSSE event =
  let eventType = Text.toLower (TaskCore.storedEventType event)
      content = TaskCore.storedEventContent event
      jsonData = case eventType of
        "assistant" -> Aeson.object ["content" Aeson..= content]
        "toolcall" ->
          let (tool, args) = parseToolCallContent content
           in Aeson.object ["tool" Aeson..= tool, "args" Aeson..= Aeson.object ["data" Aeson..= args]]
        "toolresult" ->
          Aeson.object ["tool" Aeson..= ("unknown" :: Text), "success" Aeson..= True, "output" Aeson..= content]
        "cost" -> Aeson.object ["cost" Aeson..= content]
        "error" -> Aeson.object ["error" Aeson..= content]
        "complete" -> Aeson.object []
        _ -> Aeson.object ["content" Aeson..= content]
   in formatSSE eventType (str (Aeson.encode jsonData))

formatSSE :: Text -> ByteString -> ByteString
formatSSE eventType jsonData =
  str
    <| "event: "
    <> eventType
    <> "\n"
    <> "data: "
    <> str jsonData
    <> "\n\n"

parseToolCallContent :: Text -> (Text, Text)
parseToolCallContent content =
  case Text.breakOn ":" content of
    (name, rest)
      | Text.null rest -> (content, "")
      | otherwise -> (Text.strip name, Text.strip (Text.drop 1 rest))

taskToUnixTs :: TaskCore.Task -> Int
taskToUnixTs t = ceiling (utcTimeToPOSIXSeconds (TaskCore.taskUpdatedAt t))

getReviewInfo :: Text -> IO ReviewInfo
getReviewInfo tid = do
  maybeCommit <- findCommitForTask tid
  case maybeCommit of
    Nothing -> pure ReviewNoCommit
    Just commitSha -> do
      conflictResult <- checkMergeConflict (Text.unpack commitSha)
      case conflictResult of
        Just conflictFiles -> pure (ReviewMergeConflict commitSha conflictFiles)
        Nothing -> do
          (_, diffOut, _) <-
            Process.readProcessWithExitCode
              "git"
              ["show", Text.unpack commitSha]
              ""
          pure (ReviewReady commitSha (Text.pack diffOut))

getDiffForCommit :: Text -> IO (Maybe Text)
getDiffForCommit commitSha = do
  (code, diffOut, _) <-
    Process.readProcessWithExitCode
      "git"
      ["show", Text.unpack commitSha]
      ""
  case code of
    Exit.ExitSuccess -> pure (Just (Text.pack diffOut))
    Exit.ExitFailure _ -> pure Nothing

findCommitForTask :: Text -> IO (Maybe Text)
findCommitForTask tid = do
  let grepArg = "--grep=" <> Text.unpack tid
  (code, shaOut, _) <-
    Process.readProcessWithExitCode
      "git"
      ["log", "--pretty=format:%H", "-n", "1", grepArg]
      ""
  if code /= Exit.ExitSuccess || null shaOut
    then pure Nothing
    else case List.lines shaOut of
      (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"] ""

  (cpCode, _, cpErr) <-
    Process.readProcessWithExitCode
      "git"
      ["cherry-pick", "--no-commit", commitSha]
      ""

  _ <- Process.readProcessWithExitCode "git" ["cherry-pick", "--abort"] ""
  _ <- Process.readProcessWithExitCode "git" ["reset", "--hard", List.head (List.lines origHead)] ""

  case cpCode of
    Exit.ExitSuccess -> pure Nothing
    Exit.ExitFailure _ -> do
      let errLines = Text.lines (Text.pack cpErr)
          conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines
          files = mapMaybe extractConflictFile conflictLines
      pure (Just (if null files then ["(unknown files)"] else files))

extractConflictFile :: Text -> Maybe Text
extractConflictFile line =
  case Text.breakOn "Merge conflict in " line of
    (_, rest)
      | not (Text.null rest) -> Just (Text.strip (Text.drop 18 rest))
    _ -> case Text.breakOn "in " line of
      (_, rest)
        | not (Text.null rest) -> Just (Text.strip (Text.drop 3 rest))
      _ -> Nothing