2020-07-16 10:07:28 -04:00
|
|
|
module GalleryPage (make) where
|
|
|
|
|
|
|
|
|
|
import Control.Exception
|
2020-07-18 05:43:35 -04:00
|
|
|
import Data.Function (on, (&))
|
|
|
|
|
import Data.List (sortBy, groupBy)
|
2020-07-16 10:07:28 -04:00
|
|
|
import qualified Data.Text.Lazy as Lazy
|
|
|
|
|
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
|
|
|
|
|
|
2020-07-18 05:40:56 -04:00
|
|
|
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
|
|
|
|
2020-07-18 05:40:56 -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
|
2020-07-18 05:43:35 -04:00
|
|
|
items = map (uncurry $ makeYearItems nsfw) infosByYear
|
|
|
|
|
infosByYear =
|
|
|
|
|
infos & sortBy (cmpInfo `on` #second)
|
|
|
|
|
& map (\fi -> (fi, #year $ #second fi))
|
|
|
|
|
& groupBy ((==) `on` #second)
|
|
|
|
|
& map (\ys -> (#second (head ys), map #first ys))
|
|
|
|
|
cmpInfo (Info {date = d1, title = t1}) (Info {date = d2, title = t2}) =
|
|
|
|
|
compare d2 d1 <> compare t1 t2
|
|
|
|
|
|
|
|
|
|
makeYearItems :: Bool -- ^ nsfw
|
|
|
|
|
-> Integer -- ^ year
|
|
|
|
|
-> [(FilePath, Info)]
|
|
|
|
|
-> Builder
|
|
|
|
|
makeYearItems nsfw year infos = [b|@4
|
|
|
|
|
<li class="item year-marker">
|
|
|
|
|
<span class=year-text>$^year</span>
|
|
|
|
|
$4.items
|
|
|
|
|
|]
|
|
|
|
|
where items = map (uncurry $ makeItem nsfw) infos
|
2020-07-16 10:07:28 -04:00
|
|
|
|
2020-07-18 05:40:56 -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>
|
|
|
|
|
|]
|
2020-07-18 05:40:56 -04:00
|
|
|
cls | nsfw && #anyNsfw info = [b|class="item nsfw"|]
|
|
|
|
|
| otherwise = [b|class=item|]
|
