UI: getClothR: If a Bundle exists in DB, display list of its patches

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

templates/bundle.hamlet

@@ -22,11 +22,14 @@ $nothing
     Older versions, last to first:
     <ul>
       $forall bundleID <- previousBundles
-        <a href=@{versionRoute bundleID}>
+        <li>
-          #{keyHashidText $ hashBundle bundleID}
+          <a href=@{versionRoute bundleID}>
+            #{keyHashidText $ hashBundle bundleID}
 
 <div>
   Patches, last to first:
-  $forall patchID <- patchIDs
+  <ul>
-    <a href=@{patchRoute patchID}>
+    $forall patchID <- patchIDs
-      #{keyHashidText $ hashPatch patchID}
+      <li>
+        <a href=@{patchRoute patchID}>
+          #{keyHashidText $ hashPatch patchID}

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}>