Add dropdown menus

Tasks (Ready, Blocked, Intervention, All), Plans (Epics, KB).

Task-Id: t-154.2

2 files changed, 132 insertions, 11 deletions

diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 46511a0..3327b26 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -42,7 +42,8 @@ defaultPort = 8080
 data TaskFilters = TaskFilters
   { filterStatus :: Maybe TaskCore.Status,
     filterPriority :: Maybe TaskCore.Priority,
-    filterNamespace :: Maybe Text
+    filterNamespace :: Maybe Text,
+    filterType :: Maybe TaskCore.TaskType
   }
   deriving (Show, Eq)
 
@@ -57,7 +58,9 @@ type API =
       :> QueryParam "status" Text
       :> QueryParam "priority" Text
       :> QueryParam "namespace" Text
+      :> QueryParam "type" Text
       :> Get '[Lucid.HTML] TaskListPage
+    :<|> "kb" :> Get '[Lucid.HTML] KBPage
     :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
     :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
     :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> PostRedirect
@@ -74,6 +77,7 @@ type API =
       :> QueryParam "status" Text
       :> QueryParam "priority" Text
       :> QueryParam "namespace" Text
+      :> QueryParam "type" Text
       :> Get '[Lucid.HTML] TaskListPartial
     :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
 
@@ -124,6 +128,8 @@ data TaskDiffPage
 
 data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text)
 
+newtype KBPage = KBPage [TaskCore.Task]
+
 newtype RecentActivityPartial = RecentActivityPartial [TaskCore.Task]
 
 newtype ReadyCountPartial = ReadyCountPartial Int
@@ -185,10 +191,18 @@ navbar =
     Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-brand"] "Jr"
     Lucid.div_ [Lucid.class_ "navbar-links"] <| do
       Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-link"] "Dashboard"
-      Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-link"] "Tasks"
-      Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-link"] "Ready"
-      Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-link"] "Blocked"
-      Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-link"] "Intervention"
+      Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
+        Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Tasks ▾"
+        Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
+          Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-dropdown-item"] "Ready"
+          Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-dropdown-item"] "Blocked"
+          Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-dropdown-item"] "Intervention"
+          Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-dropdown-item"] "All"
+      Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
+        Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Plans ▾"
+        Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
+          Lucid.a_ [Lucid.href_ "/tasks?type=Epic", Lucid.class_ "navbar-dropdown-item"] "Epics"
+          Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "navbar-dropdown-item"] "KB"
       Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "navbar-link"] "Stats"
 
 statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
@@ -337,6 +351,36 @@ instance Lucid.ToHtml InterventionPage where
             then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks need intervention."
             else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
 
+instance Lucid.ToHtml KBPage where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (KBPage tasks) =
+    Lucid.doctypehtml_ <| do
+      pageHead "Knowledge Base - Jr"
+      Lucid.body_ <| do
+        navbar
+        Lucid.div_ [Lucid.class_ "container"] <| do
+          Lucid.h1_ "Knowledge Base"
+          Lucid.p_ [Lucid.class_ "info-msg"] "Epic design documents and project knowledge."
+          if null tasks
+            then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics with designs yet."
+            else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderEpicCard tasks
+    where
+      renderEpicCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
+      renderEpicCard t =
+        Lucid.a_
+          [ Lucid.class_ "task-card task-card-link",
+            Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
+          ]
+          <| do
+            Lucid.div_ [Lucid.class_ "task-header"] <| do
+              Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
+              statusBadge (TaskCore.taskStatus t)
+            Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
+            case TaskCore.taskDescription t of
+              Nothing -> pure ()
+              Just desc ->
+                Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 desc <> "..."))
+
 instance Lucid.ToHtml TaskListPage where
   toHtmlRaw = Lucid.toHtml
   toHtml (TaskListPage tasks filters) =
@@ -1188,6 +1232,7 @@ server =
     :<|> interventionHandler
     :<|> statsHandler
     :<|> taskListHandler
+    :<|> kbHandler
     :<|> taskDetailHandler
     :<|> taskStatusHandler
     :<|> taskDescriptionHandler
@@ -1237,21 +1282,31 @@ server =
       stats <- liftIO <| TaskCore.getTaskStats epicId
       pure (StatsPage stats epicId)
 
-    taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
-    taskListHandler maybeStatusText maybePriorityText maybeNamespace = do
+    taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
+    taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText = do
       allTasks <- liftIO TaskCore.loadTasks
       let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
           maybePriority = parsePriority =<< emptyToNothing maybePriorityText
-          filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace)
+          maybeType = parseTaskType =<< emptyToNothing maybeTypeText
+          filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
           filteredTasks = applyFilters filters allTasks
       pure (TaskListPage filteredTasks filters)
 
+    kbHandler :: Servant.Handler KBPage
+    kbHandler = do
+      allTasks <- liftIO TaskCore.loadTasks
+      let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks
+      pure (KBPage epicTasks)
+
     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
@@ -1263,6 +1318,7 @@ server =
           matchesStatus task
             && matchesPriority task
             && matchesNamespace task
+            && matchesType task
 
         matchesStatus task = case filterStatus filters of
           Nothing -> True
@@ -1278,6 +1334,10 @@ server =
             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
       tasks <- liftIO TaskCore.loadTasks
@@ -1366,12 +1426,13 @@ server =
       readyTasks <- liftIO TaskCore.getReadyTasks
       pure (ReadyCountPartial (length readyTasks))
 
-    taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
-    taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace = do
+    taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
+    taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText = do
       allTasks <- liftIO TaskCore.loadTasks
       let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
           maybePriority = parsePriority =<< emptyToNothing maybePriorityText
-          filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace)
+          maybeType = parseTaskType =<< emptyToNothing maybeTypeText
+          filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
           filteredTasks = applyFilters filters allTasks
       pure (TaskListPartial filteredTasks)
 
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index 73b2c02..6fb793d 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -166,6 +166,7 @@ navigationStyles = do
     display flex
     Stylesheet.key "gap" ("2px" :: Text)
     flexWrap Flexbox.wrap
+    alignItems center
   ".navbar-link" ? do
     display inlineBlock
     padding (px 4) (px 10) (px 4) (px 10)
@@ -178,6 +179,43 @@ navigationStyles = do
   ".navbar-link" # hover ? do
     backgroundColor "#f3f4f6"
     textDecoration none
+  ".navbar-dropdown" ? do
+    position relative
+    display inlineBlock
+  ".navbar-dropdown-btn" ? do
+    display inlineBlock
+    padding (px 4) (px 10) (px 4) (px 10)
+    color "#374151"
+    backgroundColor transparent
+    border (px 0) none transparent
+    borderRadius (px 2) (px 2) (px 2) (px 2)
+    fontSize (px 13)
+    fontWeight (weight 500)
+    cursor pointer
+    transition "background-color" (ms 150) ease (sec 0)
+  ".navbar-dropdown-btn" # hover ? backgroundColor "#f3f4f6"
+  ".navbar-dropdown-content" ? do
+    display none
+    position absolute
+    left (px 0)
+    top (pct 100)
+    backgroundColor white
+    minWidth (px 120)
+    Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text)
+    borderRadius (px 2) (px 2) (px 2) (px 2)
+    zIndex 100
+    Stylesheet.key "overflow" ("hidden" :: Text)
+  ".navbar-dropdown" # hover |> ".navbar-dropdown-content" ? display block
+  ".navbar-dropdown-item" ? do
+    display block
+    padding (px 8) (px 12) (px 8) (px 12)
+    color "#374151"
+    textDecoration none
+    fontSize (px 13)
+    transition "background-color" (ms 150) ease (sec 0)
+  ".navbar-dropdown-item" # hover ? do
+    backgroundColor "#f3f4f6"
+    textDecoration none
   header ? do
     backgroundColor white
     padding (px 6) (px 12) (px 6) (px 12)
@@ -274,6 +312,15 @@ cardStyles = do
   ".empty-msg" ? do
     color "#6b7280"
     fontStyle italic
+  ".info-msg" ? do
+    color "#6b7280"
+    marginBottom (px 12)
+  ".kb-preview" ? do
+    color "#6b7280"
+    fontSize (px 12)
+    marginTop (px 4)
+    overflow hidden
+    Stylesheet.key "text-overflow" ("ellipsis" :: Text)
   ".ready-link" ? do
     fontSize (px 13)
     color "#0066cc"
@@ -800,6 +847,12 @@ responsiveStyles = do
     ".navbar-link" ? do
       padding (px 4) (px 6) (px 4) (px 6)
       fontSize (px 11)
+    ".navbar-dropdown-btn" ? do
+      padding (px 4) (px 6) (px 4) (px 6)
+      fontSize (px 11)
+    ".navbar-dropdown-item" ? do
+      padding (px 6) (px 10) (px 6) (px 10)
+      fontSize (px 11)
     ".nav-content" ? do
       flexDirection column
       alignItems flexStart
@@ -848,6 +901,13 @@ darkModeStyles =
     ".navbar-brand" ? color "#60a5fa"
     ".navbar-link" ? color "#d1d5db"
     ".navbar-link" # hover ? backgroundColor "#374151"
+    ".navbar-dropdown-btn" ? color "#d1d5db"
+    ".navbar-dropdown-btn" # hover ? backgroundColor "#374151"
+    ".navbar-dropdown-content" ? do
+      backgroundColor "#1f2937"
+      Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text)
+    ".navbar-dropdown-item" ? color "#d1d5db"
+    ".navbar-dropdown-item" # hover ? backgroundColor "#374151"
     ".nav-brand" ? color "#f3f4f6"
     "h2" <> "h3" ? color "#d1d5db"
     a ? color "#60a5fa"