allow updates to be marked nsfw-only

make-pages/Info.hs

@@ -1,7 +1,8 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Info
-  (Info (..), tagsFor, descFor, imagesFor, linksFor,
-   Artist (..), Image (..), Link (..),
+  (Info (..),
+   tagsFor, descFor, imagesFor, linksFor, updatesFor, compareFor, sortFor,
+   Artist (..), Image (..), Link (..), Update (..),
    GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..),
    IndexInfo (..),
    readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters,
@@ -20,10 +21,9 @@ import Data.Foldable (find)
 import Data.Hashable (Hashable)
 import Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
-import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (isJust, isNothing)
-import Data.List (nub)
+import Data.List (nub, sortBy)
 import Data.Ord (comparing)
 import Data.String (IsString)
 import Data.Text (Text)
@@ -40,7 +40,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     :: !(Map Date Text),
+    updates     :: ![Update],
     -- | if false, don't show updated emblem even if @updates@ is non-empty
     showUpdated :: !Bool,
     title       :: !Text,
@@ -83,8 +83,17 @@ data Link =
   }
   deriving (Eq, Show)
 
-instance HasField "sfw"  Image Bool where getField = not . #nsfw
-instance HasField "sfw"  Link  Bool where getField = not . #nsfw
+data Update =
+  Update {
+    date :: !Date,
+    desc :: !Text,
+    nsfw :: !Bool
+  }
+  deriving (Eq, Ord, Show)
+
+instance HasField "sfw" Image  Bool where getField = not . #nsfw
+instance HasField "sfw" Link   Bool where getField = not . #nsfw
+instance HasField "sfw" Update Bool where getField = not . #nsfw
 
 instance HasField "sfwImages" Info [Image] where
   getField = filter #sfw . #images
@@ -100,21 +109,28 @@ instance HasField "sfwLinks" Info [Link] where
 instance HasField "nsfwLinks" Info [Link] where
   getField = filter #nsfw . #links
 
+instance HasField "sfwUpdates" Info [Update] where
+  getField = filter #sfw . #updates
+instance HasField "nsfwUpdates" Info [Update] where
+  getField = filter #nsfw . #updates
+
 instance HasField "thumb" Info (Maybe FilePath) where
   getField (Info {thumb', images}) = thumb' <|> #path <$> find #sfw images
 
 instance HasField "mine"    Info Bool where getField = isNothing . #artist
 instance HasField "notMine" Info Bool where getField = isJust    . #artist
 
-instance HasField "latestDate" Info Date where
-  getField (Info {date, updates}) = maximum (date : Map.keys updates)
+instance HasField "latestDate" Info (Bool -> Date) where
+  getField info@(Info {date}) nsfw =
+    maximum $ date : map #date (updatesFor nsfw info)
 
-instance HasField "latestYear" Info Int where
-  getField = #year . #latestDate
+instance HasField "latestYear" Info (Bool -> Int) where
+  getField info nsfw = #year $ #latestDate info nsfw
 
 
-instance HasField "updated" Info Bool where
-  getField (Info {updates, showUpdated}) = showUpdated && not (Map.null updates)
+instance HasField "updated" Info (Bool -> Bool) where
+  getField (Info {updates, showUpdated}) nsfw = showUpdated && updated
+    where updated = if nsfw then not $ null updates else any #sfw updates
 
 descFor :: Bool -> Info -> Maybe Text
 descFor nsfw (Info {desc, nsfwDesc}) = desc <> (guard nsfw *> nsfwDesc)
@@ -128,8 +144,14 @@ imagesFor nsfw = if nsfw then #images else #sfwImages
 linksFor :: Bool -> Info -> [Link]
 linksFor nsfw = if nsfw then #links else #sfwLinks
 
-instance Ord Info where
-  compare = comparing \i -> (#latestDate i, #sortEx i, #title i)
+updatesFor :: Bool -> Info -> [Update]
+updatesFor nsfw = if nsfw then #updates else #sfwUpdates
+
+compareFor :: Bool -> Info -> Info -> Ordering
+compareFor nsfw = comparing \i -> (#latestDate i nsfw, #sortEx i, #title i)
+
+sortFor :: Bool -> [Info] -> [Info]
+sortFor = sortBy . compareFor
 
 
 newtype NoThumb = NoThumb FilePath
@@ -158,7 +180,7 @@ instance FromYAML Info where
   parseYAML = YAML.withMap "info" \m ->
     Info <$>  m .:  "date"
          <*>  m .:? "sort"         .!= ""
-         <*>  m .:? "updates"      .!= []
+         <*>  (maybe [] getUL <$> m .:? "updates")
          <*>  m .:? "show-updated" .!= True
          <*>  m .:  "title"
          <*>  m .:? "artist"
@@ -216,6 +238,23 @@ instance FromYAML Link where
       nsfw <- m .:? "nsfw" .!= False
       pure $ Link {title, url, nsfw}
 
+newtype UpdateList = UL {getUL :: [Update]}
+
+instance FromYAML UpdateList where
+  parseYAML y = do
+    pairs <- YAML.withMap "updates" (pure . Map.toList) y
+    UL <$> traverse asEither pairs
+   where
+    asEither (date', rest) = do
+      date <- parseYAML date'
+      asDesc date rest <|> asObj date rest
+    asDesc date = YAML.withStr "desc" \desc ->
+      pure $ Update {date, desc, nsfw = False}
+    asObj date = YAML.withMap "update info" \m -> do
+      desc <- m .:  "desc"
+      nsfw <- m .:? "nsfw" .!= False
+      pure $ Update {date, desc, nsfw}
+
 
 data GalleryInfo =
   GalleryInfo {
@@ -227,6 +266,9 @@ data GalleryInfo =
   }
   deriving (Eq, Show)
 
+instance HasField "nsfw" GalleryInfo Bool where
+  getField g = #nsfw (#filters g) /= NoNsfw
+
 data GalleryFilters =
   GalleryFilters {
     nsfw   :: !NsfwFilter,