support updates

make-pages/GalleryPage.hs

@@ -131,22 +131,27 @@ makeYearItems nsfw year infos = [b|@4
   year' = show year & foldMap \c -> [b|<span class=y>$c</span>|]
 
 makeItem :: Bool -> FilePath -> Info -> Builder
-makeItem nsfw file info@(Info {title, bg, date}) = [b|@4
-    <li class="item post$nsfw'" data-tags="$tags'" data-date="$date'">
+makeItem nsfw file info@(Info {title, bg}) = [b|@4
+    <li class="item post$nsfw'" data-date="$date'" data-updated="$updated'"
+        data-tags="$tags'">
       <figure>
         <a href="$dir">
           <img src="$thumb"$bgStyle>
         </a>
-        <figcaption>$title</figcaption>
+        <figcaption>
+          <span class=date>$date'</span>
+          <span class=title>$title</span>
+        </figcaption>
       </figure>
   |]
  where
-  dir   = takeDirectory file
-  thumb = getThumb dir info
-  nsfw' = if nsfw && #anyNsfw info then [b| nsfw|] else ""
-  tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
-  date' = formatDateShort date
-  bgStyle = ifJust bg \col -> [b| style="background: $col"|]
+  dir      = takeDirectory file
+  thumb    = getThumb dir info
+  nsfw'    = if nsfw && #anyNsfw info then [b| nsfw|] else ""
+  tags'    = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
+  date'    = formatDateShort $ #latestDate info
+  updated' = if #updated info then [b|true|] else [b|false|]
+  bgStyle  = ifJust bg \col -> [b| style="background: $col"|]
 
 formatDateShort :: Time.Day -> Builder
 formatDateShort date = [b|$day $month|] where

make-pages/Info.hs

@@ -19,6 +19,7 @@ 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)
@@ -40,6 +41,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 Day Text),
     title    :: !Text,
     artist   :: !(Maybe Artist), -- nothing = me, obv
     nsfwOnly :: !Bool,
@@ -109,6 +111,11 @@ instance HasField "year"  Info Integer where getField = #first  . #dmy
 instance HasField "month" Info Int     where getField = #second . #dmy
 instance HasField "day"   Info Int     where getField = #third  . #dmy
 
+instance HasField "latestDate" Info Day where
+  getField (Info {date, updates}) = maximum (date : Map.keys updates)
+
+instance HasField "updated" Info Bool where getField = not . Map.null . #updates
+
 descFor :: Bool -> Info -> Maybe Text
 descFor nsfw (Info {desc, nsfwDesc}) = desc <> (guard nsfw *> nsfwDesc)
 
@@ -122,7 +129,7 @@ linksFor :: Bool -> Info -> [Link]
 linksFor nsfw = if nsfw then #links else #sfwLinks
 
 instance Ord Info where
-  compare = comparing \Info {date, sortEx, title} -> (date, sortEx, title)
+  compare = comparing \i -> (#latestDate i, #sortEx i, #title i)
 
 
 newtype NoThumb = NoThumb FilePath
@@ -150,7 +157,8 @@ addSuffix suf path =
 instance FromYAML Info where
   parseYAML = YAML.withMap "info" \m ->
     Info <$>  m .:  "date"
-         <*>  m .:? "sort" .!= ""
+         <*>  m .:? "sort"    .!= ""
+         <*>  m .:? "updates" .!= []
          <*>  m .:  "title"
          <*>  m .:? "artist"
          <*>  m .:? "nsfw-only" .!= False

make-pages/SinglePage.hs

@@ -5,10 +5,11 @@ import BuilderQQ
 import Records ()
 
 import Control.Exception
+import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as Strict
 import qualified Data.Text.Lazy as Lazy
-import qualified Data.Time.Calendar as Time
+import qualified Data.Time as Time
 import System.FilePath (joinPath, splitPath, (</>))
 import qualified System.Process as Proc
 import Text.Read (readMaybe)
@@ -34,7 +35,8 @@ make root prefix nsfw dataDir dir info =
   toLazyText <$> make' root prefix nsfw dataDir dir info
 
 make' :: Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder
-make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
+make' root prefix nsfw dataDir dir
+      info@(Info {date, title, artist, bg, updates}) = do
   images <- withSizes (dataDir </> dir) $ imagesFor nsfw info
 
   let undir = joinPath (replicate (length (splitPath dir)) "..")
@@ -53,6 +55,7 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
   let descSection = makeDesc $ descFor nsfw info
   let tagsList    = makeTags undir $ tagsFor nsfw info
   let linksList   = extLinks $ linksFor nsfw info
+  let updatesList = makeUpdates $ Map.toList updates
 
   let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$path>|]
   let prefetches = map (makePrefetch . #first) $ tail images
@@ -76,6 +79,9 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
         Nothing -> "by niss"
   let thumb = getThumb "" info
 
+  let updateDate = ifJust (Map.lookupMax updates) \(formatDate -> u, _) ->
+        [b|<br> <span class=updated>updated $u</span>|]
+
   pure [b|@0
     <!DOCTYPE html>
     <html lang=en>
@@ -103,7 +109,9 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
     <header>
       <h1>$title</h1>
       $artistTag
-      <h2 id=date class="right corner">$formattedDate</h2>
+      <h2 id=date class="right corner">
+        $formattedDate $updateDate
+      </h2>
     </header>
 
     $buttonBar
@@ -122,6 +130,8 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
         $tagsList
 
         $linksList
+
+        $updatesList
       </div>
     </main>
 
@@ -217,6 +227,25 @@ extLink (Link {title, url}) = [b|@8
       </a>
   |]
 
+makeUpdates :: [(Day, Text)] -> Builder
+makeUpdates ups =
+  if null ups then "" else [b|@4
+    <section id=updates class=info-section>
+      <h2>updates</h2>
+      <dl>
+        $8.updateList
+      </dl>
+    </section>
+  |]
+  where updateList = map (uncurry makeUpdate) ups
+
+makeUpdate :: Day -> Text -> Builder
+makeUpdate date txt = [b|@8
+    <dt>$date'
+    <dd>$txt
+  |]
+  where date' = Time.formatTime Time.defaultTimeLocale "%-d/%-m/%Y" date
+
 formatDate :: Day -> Builder
 formatDate date = [b|$week $day $month $year|] where
   (year, month', day') = Time.toGregorian date