support updates
This commit is contained in:
parent
e296e41b8b
commit
7f91331195
7 changed files with 120 additions and 39 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue