support updates

This commit is contained in:
Rhiannon Morris 2020-09-19 07:51:52 +02:00
parent e296e41b8b
commit 7f91331195
7 changed files with 120 additions and 39 deletions

View file

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