allow multiple updates on one day

[the reason for this, rather than just one update listing everything, is
that i can have sfw and nsfw updates and only display the appropriate
one]

make-pages/Info.hs

@@ -44,7 +44,7 @@ data Info =
     -- e.g. multiple things on the same day might have a,b,c in @sortEx@ to
     -- put them in the right order in the gallery
     sortEx       :: !Text,
-    updates      :: ![Update],
+    updates      :: ![(Date, [Update])],
     -- | if false, don't show updated emblem even if @updates@ is non-empty
     showUpdated  :: !Bool,
     -- | hide from gallery view
@@ -109,7 +109,6 @@ data Link =
 
 data Update =
   Update {
-    date       :: !Date,
     desc       :: !Text,
     nsfw       :: !Bool,
     ignoreSort :: !Bool
@@ -143,10 +142,10 @@ instance HasField "sfwLinks" Info [Link] where
 instance HasField "nsfwLinks" Info [Link] where
   getField = filter #nsfw . #links
 
-instance HasField "sfwUpdates" Info [Update] where
+instance HasField "sfwUpdates" Info [(Date, [Update])] where
-  getField = filter #sfw . #updates
+  getField = filter (not . null) . map (second (filter #sfw)) . #updates
-instance HasField "nsfwUpdates" Info [Update] where
+instance HasField "nsfwUpdates" Info [(Date, [Update])] where
-  getField = filter #nsfw . #updates
+  getField = filter (not . null) . map (second (filter #nsfw)) . #updates
 
 instance HasField "thumb" Info (Maybe FilePath) where
   getField (Info {thumb', images}) =
@@ -158,15 +157,15 @@ instance HasField "notMine" Info Bool where getField = isJust    . #artist
 instance HasField "latestDate" Info (Bool -> Date) where
   getField info@(Info {date=date₀}) nsfw =
     maximum $ date₀ : mapMaybe relDate (updatesFor nsfw info)
-   where relDate (Update {date, ignoreSort}) = date <$ guard (not ignoreSort)
+   where relDate (date, us) = date <$ guard (not $ any #ignoreSort us)
 
 instance HasField "latestYear" Info (Bool -> Int) where
   getField info nsfw = #year $ #latestDate info nsfw
 
 
 instance HasField "updated" Info (Bool -> Bool) where
-  getField (Info {updates, showUpdated}) nsfw = showUpdated && updated
+  getField (Info {updates, showUpdated}) nsfw = showUpdated && updated where
-    where updated = if nsfw then not $ null updates else any #sfw updates
+    updated = if nsfw then not $ null updates else any (any #sfw . snd) updates
 
 defDescKey :: Text
 defDescKey = "about"
@@ -212,7 +211,7 @@ imagesFor nsfw = if nsfw then #images else #sfwImages
 linksFor :: Bool -> Info -> [Link]
 linksFor nsfw = if nsfw then #links else #sfwLinks
 
-updatesFor :: Bool -> Info -> [Update]
+updatesFor :: Bool -> Info -> [(Date, [Update])]
 updatesFor nsfw = if nsfw then #updates else #sfwUpdates
 
 compareFor :: Bool -> Info -> Info -> Ordering
@@ -346,21 +345,23 @@ instance FromYAML Link where
       pure $ Link {title, url, nsfw}
 
 
-updateList :: Maybe (YAML.Node YAML.Pos) -> YAML.Parser [Update]
+updateList :: Maybe (YAML.Node YAML.Pos) -> YAML.Parser [(Date, [Update])]
 updateList =
-  maybe (pure []) $ YAML.withMap "updates" $ traverse asEither . Map.toList
+  maybe (pure []) $ YAML.withMap "updates" $ traverse bodies . Map.toList
  where
-  asEither (date', rest) = do
+  bodies (date', rest) = (,) <$> parseYAML date' <*> body rest
-    date <- parseYAML date'
+  body b =
-    asDesc date rest <|> asObj date rest
+        return <$> body1 b
-  asDesc date = YAML.withStr "desc" \desc ->
+    <|> YAML.withSeq "update list" (traverse body1) b
-    pure $ Update {date, desc, nsfw = False, ignoreSort = False}
+  body1 b = asDesc b <|> asObj b
-  asObj date = YAML.withMap "update info" \m -> do
+  asDesc = YAML.withStr "desc" \desc ->
+    pure $ Update {desc, nsfw = False, ignoreSort = False}
+  asObj = YAML.withMap "update info" \m -> do
     checkKeys m ["desc", "nsfw", "ignore-sort"]
     desc       <- m .:  "desc"
     nsfw       <- m .:? "nsfw"        .!= False
     ignoreSort <- m .:? "ignore-sort" .!= False
-    pure $ Update {date, desc, nsfw, ignoreSort}
+    pure $ Update {desc, nsfw, ignoreSort}
 
 
 data GalleryInfo =

make-pages/SinglePage.hs

@@ -8,7 +8,7 @@ import qualified NsfwWarning
 
 import Control.Exception
 import Control.Monad
-import Data.List (sort)
+import Data.List (sort, intersperse)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as Strict
 import qualified Data.Text.Lazy as Lazy
@@ -86,7 +86,7 @@ make' root prefix nsfw _dataDir dir info@(Info {date, title, artist, bg}) = do
         Nothing -> "by niss"
   let thumb = getThumb "" info
 
-  let updateDate = ifJust (last' updates) \(Update {date = d}) ->
+  let updateDate = ifJust (last' updates) \(d, _) ->
         let updated = formatLong d in
         [b|<br> <span class=updated>updated $updated</span>|]
 
@@ -286,7 +286,7 @@ extLink (Link {title, url}) = [b|@8
       </a>
   |]
 
-makeUpdates :: [Update] -> Builder
+makeUpdates :: [(Date, [Update])] -> Builder
 makeUpdates ups =
   if null ups then "" else [b|@4
     <section id=updates class=info-section>
@@ -296,11 +296,12 @@ makeUpdates ups =
       </dl>
     </section>
   |]
- where updateList = map makeUpdate ups
+ where updateList = map (uncurry makeUpdate) ups
 
-makeUpdate :: Update -> Builder
+makeUpdate :: Date -> [Update] -> Builder
-makeUpdate (Update {date, desc}) = [b|@8
+makeUpdate date ups = [b|@8
     <dt>$date'
     <dd>$desc
-  |]
+  |] where
-  where date' = formatSlash date
+  date' = formatSlash date
+  desc  = mconcat $ map fromText $ intersperse "; " $ map #desc ups