add support for categorised alts

make-pages/SinglePage.hs

@@ -47,8 +47,8 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
 
   let buttonBar = makeButtonBar title images
   let (image0@(Image {path = path0, download = download0'}),
-       Size {width = width0, height = height0})
-        = head images
+       Size {width = width0, height = height0}) : otherImages
+        = #all images
   let download0 = fromMaybe path0 download0'
   let path0'    = pageFile path0
   let tinyCls   = if any (tiny . #second) images then [b| class=tiny|] else ""
@@ -60,7 +60,7 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
   let updatesList = makeUpdates updates
 
   let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$path>|]
-  let prefetches = map (makePrefetch . #first) $ tail images
+  let prefetches = map (makePrefetch . #first) otherImages
 
   let makeWarning w = [b|@0
         <figcaption id=cw aria-role=button tabindex=0>
@@ -195,24 +195,35 @@ makeDesc (LongDesc fs) = [b|@0
       </div>
     |]
 
-makeButtonBar :: Strict.Text -> [(Image, Size)] -> Builder
+makeButtonBar :: Strict.Text -> Images' (Image, Size) -> Builder
 makeButtonBar title images =
   case images of
-    []  -> throw $ NoEligibleImages title
-    [_] -> ""
-    _   -> [b|@0
-      <nav id=alts aria-label="alternate versions">
+    Uncat []        -> throw $ NoEligibleImages title
+    Uncat [_]       -> ""
+    Cat   [(_,[_])] -> ""
+    Uncat imgs      -> makeNav "uncat" $ makeAlts imgs
+    Cat   cats      -> makeNav "cat"   $ map (uncurry makeCat) cats
+ where
+   makeNav (cls :: Text) inner = [b|@0
+      <nav id=alts class=$cls aria-label="alternate versions">
+        $2.inner
+      </nav> |]
+   makeCat lbl imgs = [b|@0
+       <section>
+         <h3 class=alt-cat>$lbl</h3>
+         $0.alts
+       </section> |]
+     where alts = makeAlts imgs
+   makeAlts imgs = [b|@0
         <ul class="buttonbar bb-choice">
-          $4.alts
-        </ul>
-      </nav>
-      |]
- where alts = map (\(i, (im, sz)) -> altButton i im sz) $ zip [0..] images
+          $2.elems
+        </ul> |]
+     where elems = map (uncurry altButton) imgs
 
-altButton :: Int -> Image -> Size -> Builder
-altButton i img size = [b|@0
+altButton :: Image -> Size -> Builder
+altButton img size = [b|@0
   <li$nsfwClass>
-    <input type=radio$checked name=variant id="$idLabel" value="$path'"
+    <input type=radio name=variant id="$idLabel" value="$path'"
            data-link="$link"$warning'
            data-width=$width data-height=$height>
     <label for="$idLabel"$nsfwLabelClass>$label</label>
@@ -222,7 +233,6 @@ altButton i img size = [b|@0
   Size {width, height} = size
   nsfwClass      = if nsfw then [b| class=nsfw|]       else ""
   nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else ""
-  checked        = if i == 0 then [b| checked|] else ""
   idLabel        = escId label
   path'          = pageFile path
   link           = fromMaybe path download
@@ -297,7 +307,7 @@ imageSize dir img = do
     Just (width, height) -> pure $ Size {width, height}
     Nothing -> fail $ "couldn't understand identify output:\n" ++ output
 
-withSizes :: FilePath -> [Image] -> IO [(Image, Size)]
+withSizes :: Traversable t => FilePath -> t Image -> IO (t (Image, Size))
 withSizes dir = traverse \img -> do
   size <- imageSize dir $ #path img
   pure (img, size)