gallery/make-pages/GalleryPage.hs

70 lines
1.7 KiB
Haskell

module GalleryPage (make) where
import Control.Exception
import Data.Function (on)
import Data.List (sortBy)
import Data.Ord (comparing)
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder (Builder, toLazyText)
import System.FilePath ((</>), takeDirectory)
import BuilderQQ
import Depend (thumbFile)
import Info
newtype NoThumb = NoThumb FilePath
deriving stock Eq deriving anyclass Exception
instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir
make :: Text -- ^ title
-> Bool -- ^ nsfw is included?
-> [(FilePath, Info)]
-> Lazy.Text
make title nsfw infos = toLazyText $ make' title nsfw infos
make' :: Text -> Bool -> [(FilePath, Info)] -> Builder
make' title nsfw infos = [b|@0
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
<link rel=stylesheet href=/style/gallery.css>
<title>$*title</title>
<header>
<h1>$*title</h1>
</header>
<main>
<ul class=grid>
$4.items
</ul>
</main>
|]
where
items = map (uncurry makeItem) infos
infos = sortBy (cmpInfo `on` snd) infos'
cmpInfo = flip (comparing #date) <> comparing #title
makeItem :: Bool -> FilePath -> Info -> Builder
makeItem nsfw file info = [b|@4
<li $cls>
<figure>
<a href="$@dir">
<img src="$@thumb">
</a>
$title
</figure>
|]
where
dir = takeDirectory file
thumb = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) $ #thumb info
title = maybe mempty mkTitle $ #title info
mkTitle t = [b|@8
<figcaption>
$*t
</figcaption>
|]
cls | nsfw && #anyNsfw info = [b|class="item nsfw"|]
| otherwise = [b|class=item|]