1 files changed, 345 insertions, 0 deletions
diff --git a/Omni/Jr/Web/Types.hs b/Omni/Jr/Web/Types.hs
new file mode 100644
index 0000000..c463bfa
--- /dev/null
+++ b/Omni/Jr/Web/Types.hs
@@ -0,0 +1,345 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- : dep servant-server
+-- : dep lucid
+-- : dep http-api-data
+-- : dep aeson
+module Omni.Jr.Web.Types
+  ( TaskFilters (..),
+    TimeRange (..),
+    SortOrder (..),
+    parseSortOrder,
+    sortOrderToParam,
+    sortOrderLabel,
+    sortTasks,
+    parseTimeRange,
+    timeRangeToParam,
+    getTimeRangeStart,
+    startOfDay,
+    startOfWeek,
+    addDays,
+    fromGregorian,
+    daysSinceEpoch,
+    startOfMonth,
+    computeMetricsFromActivities,
+    HomePage (..),
+    ReadyQueuePage (..),
+    BlockedPage (..),
+    InterventionPage (..),
+    TaskListPage (..),
+    TaskDetailPage (..),
+    GitCommit (..),
+    TaskReviewPage (..),
+    ReviewInfo (..),
+    TaskDiffPage (..),
+    StatsPage (..),
+    KBPage (..),
+    FactDetailPage (..),
+    EpicsPage (..),
+    RecentActivityNewPartial (..),
+    RecentActivityMorePartial (..),
+    ReadyCountPartial (..),
+    StatusBadgePartial (..),
+    PriorityBadgePartial (..),
+    TaskListPartial (..),
+    TaskMetricsPartial (..),
+    AgentEventsPartial (..),
+    DescriptionViewPartial (..),
+    DescriptionEditPartial (..),
+    FactEditForm (..),
+    FactCreateForm (..),
+    RejectForm (..),
+    StatusForm (..),
+    PriorityForm (..),
+    DescriptionForm (..),
+    NotesForm (..),
+    CommentForm (..),
+    Breadcrumb (..),
+    Breadcrumbs,
+    CSS,
+    SSE,
+  )
+where
+
+import Alpha
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as LazyText
+import Data.Time (Day, UTCTime (..), diffUTCTime, toGregorian)
+import Data.Time.Calendar (DayOfWeek (..))
+import Data.Time.Calendar.WeekDate (toWeekCalendar)
+import qualified Lucid
+import qualified Omni.Task.Core as TaskCore
+import Servant (Accept (..), MimeRender (..))
+import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique)
+
+data TaskFilters = TaskFilters
+  { filterStatus :: Maybe TaskCore.Status,
+    filterPriority :: Maybe TaskCore.Priority,
+    filterNamespace :: Maybe Text,
+    filterType :: Maybe TaskCore.TaskType
+  }
+  deriving (Show, Eq)
+
+data TimeRange = Today | Week | Month | AllTime
+  deriving (Show, Eq)
+
+data SortOrder
+  = SortNewest
+  | SortOldest
+  | SortUpdated
+  | SortPriorityHigh
+  | SortPriorityLow
+  deriving (Show, Eq)
+
+parseSortOrder :: Maybe Text -> SortOrder
+parseSortOrder (Just "oldest") = SortOldest
+parseSortOrder (Just "updated") = SortUpdated
+parseSortOrder (Just "priority-high") = SortPriorityHigh
+parseSortOrder (Just "priority-low") = SortPriorityLow
+parseSortOrder _ = SortNewest
+
+sortOrderToParam :: SortOrder -> Text
+sortOrderToParam SortNewest = "newest"
+sortOrderToParam SortOldest = "oldest"
+sortOrderToParam SortUpdated = "updated"
+sortOrderToParam SortPriorityHigh = "priority-high"
+sortOrderToParam SortPriorityLow = "priority-low"
+
+sortOrderLabel :: SortOrder -> Text
+sortOrderLabel SortNewest = "Newest First"
+sortOrderLabel SortOldest = "Oldest First"
+sortOrderLabel SortUpdated = "Recently Updated"
+sortOrderLabel SortPriorityHigh = "Priority (High to Low)"
+sortOrderLabel SortPriorityLow = "Priority (Low to High)"
+
+sortTasks :: SortOrder -> [TaskCore.Task] -> [TaskCore.Task]
+sortTasks SortNewest = List.sortBy (comparing (Down <. TaskCore.taskCreatedAt))
+sortTasks SortOldest = List.sortBy (comparing TaskCore.taskCreatedAt)
+sortTasks SortUpdated = List.sortBy (comparing (Down <. TaskCore.taskUpdatedAt))
+sortTasks SortPriorityHigh = List.sortBy (comparing TaskCore.taskPriority)
+sortTasks SortPriorityLow = List.sortBy (comparing (Down <. TaskCore.taskPriority))
+
+parseTimeRange :: Maybe Text -> TimeRange
+parseTimeRange (Just "today") = Today
+parseTimeRange (Just "week") = Week
+parseTimeRange (Just "month") = Month
+parseTimeRange _ = AllTime
+
+timeRangeToParam :: TimeRange -> Text
+timeRangeToParam Today = "today"
+timeRangeToParam Week = "week"
+timeRangeToParam Month = "month"
+timeRangeToParam AllTime = "all"
+
+getTimeRangeStart :: TimeRange -> UTCTime -> Maybe UTCTime
+getTimeRangeStart AllTime _ = Nothing
+getTimeRangeStart Today now = Just (startOfDay now)
+getTimeRangeStart Week now = Just (startOfWeek now)
+getTimeRangeStart Month now = Just (startOfMonth now)
+
+startOfDay :: UTCTime -> UTCTime
+startOfDay t = UTCTime (utctDay t) 0
+
+startOfWeek :: UTCTime -> UTCTime
+startOfWeek t =
+  let day = utctDay t
+      (_, _, dow) = toWeekCalendar day
+      daysBack = dow - 1
+   in UTCTime (addDays (negate (toInteger daysBack)) day) 0
+
+addDays :: Integer -> Day -> Day
+addDays n d =
+  let (y, m, dayNum) = toGregorian d
+   in fromGregorian y m (dayNum + fromInteger n)
+
+fromGregorian :: Integer -> Int -> Int -> Day
+fromGregorian y m d = toEnum (fromInteger (daysSinceEpoch y m d))
+
+daysSinceEpoch :: Integer -> Int -> Int -> Integer
+daysSinceEpoch y m d =
+  let a = (14 - m) `div` 12
+      y' = y + 4800 - toInteger a
+      m' = m + 12 * a - 3
+      jdn = d + (153 * m' + 2) `div` 5 + 365 * fromInteger y' + fromInteger y' `div` 4 - fromInteger y' `div` 100 + fromInteger y' `div` 400 - 32045
+   in toInteger jdn - 2440588
+
+startOfMonth :: UTCTime -> UTCTime
+startOfMonth t =
+  let day = utctDay t
+      (y, m, _) = toGregorian day
+   in UTCTime (fromGregorian y m 1) 0
+
+computeMetricsFromActivities :: [TaskCore.Task] -> [TaskCore.TaskActivity] -> TaskCore.AggregatedMetrics
+computeMetricsFromActivities tasks activities =
+  let completedCount = length [t | t <- tasks, TaskCore.taskStatus t == TaskCore.Done]
+      totalCost = sum [c | act <- activities, Just c <- [TaskCore.activityCostCents act]]
+      totalTokens = sum [t | act <- activities, Just t <- [TaskCore.activityTokensUsed act]]
+      totalDuration = sum [calcDuration act | act <- activities]
+   in TaskCore.AggregatedMetrics
+        { TaskCore.aggTotalCostCents = totalCost,
+          TaskCore.aggTotalDurationSeconds = totalDuration,
+          TaskCore.aggCompletedTasks = completedCount,
+          TaskCore.aggTotalTokens = totalTokens
+        }
+  where
+    calcDuration act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
+      (Just start, Just end) -> floor (diffUTCTime end start)
+      _ -> 0
+
+data CSS
+
+instance Accept CSS where
+  contentType _ = "text/css"
+
+instance MimeRender CSS LazyText.Text where
+  mimeRender _ = LazyText.encodeUtf8
+
+data SSE
+
+instance Accept SSE where
+  contentType _ = "text/event-stream"
+
+instance MimeRender SSE BS.ByteString where
+  mimeRender _ = LBS.fromStrict
+
+data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool TaskCore.AggregatedMetrics TimeRange UTCTime
+
+data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] SortOrder UTCTime
+
+data BlockedPage = BlockedPage [(TaskCore.Task, Int)] SortOrder UTCTime
+
+data InterventionPage = InterventionPage TaskCore.HumanActionItems SortOrder UTCTime
+
+data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime
+
+data TaskDetailPage
+  = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) [TaskCore.StoredEvent] UTCTime
+  | 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
+
+data ReviewInfo
+  = ReviewNoCommit
+  | ReviewMergeConflict Text [Text]
+  | ReviewReady Text Text
+
+data TaskDiffPage
+  = DiffPageFound Text Text Text
+  | DiffPageNotFound Text Text
+
+data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text)
+
+newtype KBPage = KBPage [TaskCore.Fact]
+
+data FactDetailPage
+  = FactDetailFound TaskCore.Fact UTCTime
+  | FactDetailNotFound Int
+
+data FactEditForm = FactEditForm Text Text Text
+
+instance FromForm FactEditForm where
+  fromForm form = do
+    content <- parseUnique "content" form
+    let files = fromRight "" (lookupUnique "files" form)
+    let confidence = fromRight "0.8" (lookupUnique "confidence" form)
+    Right (FactEditForm content files confidence)
+
+data FactCreateForm = FactCreateForm Text Text Text Text
+
+instance FromForm FactCreateForm where
+  fromForm form = do
+    project <- parseUnique "project" form
+    content <- parseUnique "content" form
+    let files = fromRight "" (lookupUnique "files" form)
+    let confidence = fromRight "0.8" (lookupUnique "confidence" form)
+    Right (FactCreateForm project content files confidence)
+
+data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] SortOrder
+
+data RecentActivityNewPartial = RecentActivityNewPartial [TaskCore.Task] (Maybe Int)
+
+data RecentActivityMorePartial = RecentActivityMorePartial [TaskCore.Task] Int Bool
+
+newtype ReadyCountPartial = ReadyCountPartial Int
+
+data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
+
+data PriorityBadgePartial = PriorityBadgePartial TaskCore.Priority Text
+
+newtype TaskListPartial = TaskListPartial [TaskCore.Task]
+
+data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime
+
+data AgentEventsPartial = AgentEventsPartial [TaskCore.StoredEvent] Bool UTCTime
+
+data DescriptionViewPartial = DescriptionViewPartial Text Text Bool
+
+data DescriptionEditPartial = DescriptionEditPartial Text Text Bool
+
+newtype RejectForm = RejectForm (Maybe Text)
+
+instance FromForm RejectForm where
+  fromForm form = Right (RejectForm (either (const Nothing) Just (lookupUnique "notes" form)))
+
+newtype StatusForm = StatusForm TaskCore.Status
+
+instance FromForm StatusForm where
+  fromForm form = do
+    statusText <- parseUnique "status" form
+    case readMaybe (Text.unpack statusText) of
+      Just s -> Right (StatusForm s)
+      Nothing -> Left "Invalid status"
+
+newtype PriorityForm = PriorityForm TaskCore.Priority
+
+instance FromForm PriorityForm where
+  fromForm form = do
+    priorityText <- parseUnique "priority" form
+    case readMaybe (Text.unpack priorityText) of
+      Just p -> Right (PriorityForm p)
+      Nothing -> Left "Invalid priority"
+
+newtype DescriptionForm = DescriptionForm Text
+
+instance FromForm DescriptionForm where
+  fromForm form = do
+    desc <- parseUnique "description" form
+    Right (DescriptionForm desc)
+
+newtype NotesForm = NotesForm Text
+
+instance FromForm NotesForm where
+  fromForm form = do
+    notes <- parseUnique "notes" form
+    Right (NotesForm notes)
+
+newtype CommentForm = CommentForm Text
+
+instance FromForm CommentForm where
+  fromForm form = do
+    commentText <- parseUnique "comment" form
+    Right (CommentForm commentText)
+
+data Breadcrumb = Breadcrumb
+  { breadcrumbLabel :: Text,
+    breadcrumbUrl :: Maybe Text
+  }
+
+type Breadcrumbs = [Breadcrumb]