From 0b10056cc3be9ff2fa95812f46f0f28f67251b86 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Mon, 19 Sep 2022 12:02:48 +0000
Subject: [PATCH] UI: getClothR: If a Bundle exists in DB, display list of its
 patches

---
 src/Vervis/Handler/Cloth.hs | 14 ++++++++++++--
 templates/bundle.hamlet     | 13 ++++++++-----
 templates/cloth/one.hamlet  | 12 ++++++++++++
 3 files changed, 32 insertions(+), 7 deletions(-)

diff --git a/src/Vervis/Handler/Cloth.hs b/src/Vervis/Handler/Cloth.hs
index ce658aa..3d78ce8 100644
--- a/src/Vervis/Handler/Cloth.hs
+++ b/src/Vervis/Handler/Cloth.hs
@@ -265,10 +265,10 @@ getClothR loomHash clothHash = do
     where
     getClothHtml = do
         mpid <- maybeAuthId
-        (ticket, targetRepo, author, tparams, eparams, cparams, moriginRepo) <- handlerToWidget $ runDB $ do
+        (ticket, targetRepo, author, tparams, eparams, cparams, moriginRepo, mbundle) <- handlerToWidget $ runDB $ do
             (Entity _ loom, Entity _ cloth, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr, proposal) <-
                 getCloth404 loomHash clothHash
-            (ticket,,,,,,)
+            (ticket,,,,,,,)
                 <$> getLocalRepo (loomRepo loom) (ticketLoomBranch cloth)
                 <*> bitraverse
                         (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
@@ -295,6 +295,14 @@ getClothR loomHash clothHash = do
                                 )
                         )
                         (justThere proposal)
+                <*> traverse
+                        (\ (bundleID :| _) -> do
+                            ids <- selectKeysList [PatchBundle ==. bundleID] [Desc PatchId]
+                            case nonEmpty ids of
+                                Nothing -> error "Bundle without any Patches in DB"
+                                Just ne -> return (bundleID, ne)
+                        )
+                        (justHere proposal)
         hashMessageKey <- handlerToWidget getEncodeKeyHashid
         let desc :: Widget
             desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket
@@ -316,6 +324,8 @@ getClothR loomHash clothHash = do
                     (ClothFollowR loomHash clothHash)
                     (ClothUnfollowR loomHash clothHash)
                     (ticketFollowers ticket)
+        hashBundle <- handlerToWidget getEncodeKeyHashid
+        hashPatch <- handlerToWidget getEncodeKeyHashid
         $(widgetFile "cloth/one")
         where
         getLocalRepo repoID mbranch = do
diff --git a/templates/bundle.hamlet b/templates/bundle.hamlet
index be75730..a052571 100644
--- a/templates/bundle.hamlet
+++ b/templates/bundle.hamlet
@@ -22,11 +22,14 @@ $nothing
     Older versions, last to first:
     <ul>
       $forall bundleID <- previousBundles
-        <a href=@{versionRoute bundleID}>
-          #{keyHashidText $ hashBundle bundleID}
+        <li>
+          <a href=@{versionRoute bundleID}>
+            #{keyHashidText $ hashBundle bundleID}
 
 <div>
   Patches, last to first:
-  $forall patchID <- patchIDs
-    <a href=@{patchRoute patchID}>
-      #{keyHashidText $ hashPatch patchID}
+  <ul>
+    $forall patchID <- patchIDs
+      <li>
+        <a href=@{patchRoute patchID}>
+          #{keyHashidText $ hashPatch patchID}
diff --git a/templates/cloth/one.hamlet b/templates/cloth/one.hamlet
index 5cc654c..6f9f71c 100644
--- a/templates/cloth/one.hamlet
+++ b/templates/cloth/one.hamlet
@@ -54,6 +54,18 @@ $with (repoHash, name, maybeBranch) <- targetRepo
       <a href=@{RepoBranchSourceR repoHash branch []}>
         #{branch}
 
+$maybe (bundleID, patchIDs) <- mbundle
+  <div>
+    Bundle
+    <a href=@{BundleR loomHash clothHash (hashBundle bundleID)}>
+      #{keyHashidText $ hashBundle bundleID}
+    patches, last to first:
+    <ul>
+      $forall patchID <- patchIDs
+        <li>
+          <a href=@{PatchR loomHash clothHash (hashBundle bundleID) (hashPatch patchID)}>
+            #{keyHashidText $ hashPatch patchID}
+
 <div>
   <span>
     <a href=@{ClothFollowersR loomHash clothHash}>