gallery/make-pages/GalleryPage.hs

70 lines
1.7 KiB
Haskell
Raw Normal View History

2020-07-16 10:07:28 -04:00
module GalleryPage (make) where
import Control.Exception
2020-07-17 10:01:04 -04:00
import Data.Function (on)
import Data.List (sortBy)
import Data.Ord (comparing)
2020-07-16 10:07:28 -04:00
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
2020-07-16 10:07:28 -04:00
make' :: Text -> Bool -> [(FilePath, Info)] -> Builder
make' title nsfw infos = [b|@0
2020-07-16 10:07:28 -04:00
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
2020-07-17 06:29:13 -04:00
<link rel=stylesheet href=/style/gallery.css>
2020-07-16 10:07:28 -04:00
<title>$*title</title>
<header>
<h1>$*title</h1>
</header>
<main>
<ul class=grid>
$4.items
</ul>
</main>
|]
where
items = map (uncurry makeItem) infos
2020-07-17 10:01:04 -04:00
infos = sortBy (cmpInfo `on` snd) infos'
cmpInfo = flip (comparing #date) <> comparing #title
2020-07-16 10:07:28 -04:00
makeItem :: Bool -> FilePath -> Info -> Builder
makeItem nsfw file info = [b|@4
<li $cls>
2020-07-16 10:07:28 -04:00
<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|]