{-# 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 (..), ComplexityBadgePartial (..), TaskListPartial (..), TaskMetricsPartial (..), AgentEventsPartial (..), DescriptionViewPartial (..), DescriptionEditPartial (..), FactEditForm (..), FactCreateForm (..), RejectForm (..), StatusForm (..), PriorityForm (..), ComplexityForm (..), 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 qualified Data.Text.Lazy.Encoding as LazyText import Data.Time (Day, DayOfWeek (..), UTCTime (..), dayOfWeek, diffUTCTime, toGregorian) 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 = dayOfWeek day daysBack = case dow of Monday -> 0 Tuesday -> 1 Wednesday -> 2 Thursday -> 3 Friday -> 4 Saturday -> 5 Sunday -> 6 in UTCTime (addDays (negate 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 data ComplexityBadgePartial = ComplexityBadgePartial (Maybe Int) Text newtype TaskListPartial = TaskListPartial [TaskCore.Task] data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime data AgentEventsPartial = AgentEventsPartial Text [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 ComplexityForm = ComplexityForm (Maybe Int) instance FromForm ComplexityForm where fromForm form = do complexityText <- parseUnique "complexity" form if complexityText == "none" then Right (ComplexityForm Nothing) else case readMaybe (Text.unpack complexityText) of Just c | c >= 1 && c <= 5 -> Right (ComplexityForm (Just c)) _ -> Left "Invalid complexity" 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]