gallery/make-pages/GalleryPage.hs

92 lines
2.5 KiB
Haskell
Raw Normal View History

2020-07-19 11:55:54 -04:00
{-# LANGUAGE TransformListComp #-}
2020-07-16 10:07:28 -04:00
module GalleryPage (make) where
import Control.Exception
2020-07-20 16:40:34 -04:00
import Data.Function (on, (&))
2020-07-19 11:55:54 -04:00
import Data.List (sortOn, groupBy)
2020-07-16 10:07:28 -04:00
import qualified Data.Text.Lazy as Lazy
import System.FilePath ((</>), takeDirectory, joinPath, splitPath)
2020-07-19 11:55:54 -04:00
import GHC.Exts (Down (..), the)
2020-07-16 10:07:28 -04:00
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
-> FilePath -- ^ gallery url prefix
-> Bool -- ^ nsfw is included?
-> [(FilePath, Info)]
-> Lazy.Text
make title prefix nsfw infos = toLazyText $ make' title prefix nsfw infos
2020-07-16 10:07:28 -04:00
make' :: Text -> FilePath -> Bool -> [(FilePath, Info)] -> Builder
make' title prefix nsfw infos = [b|@0
2020-07-16 10:07:28 -04:00
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
2020-07-21 03:16:05 -04:00
<link rel=stylesheet href=/style/shiny/gallery.css title=shiny>
<link rel='alternate stylesheet' href=/style/tum/gallery.css title=tummy>
2020-07-19 12:04:40 -04:00
<link rel=alternate href=rss.xml type=application/rss+xml>
2020-07-16 10:07:28 -04:00
<title>$*title</title>
<header>
<h1>$*title</h1>
2020-07-19 12:04:40 -04:00
<h2 class="right corner">
<a href=rss.xml>rss</a>
</h2>
2020-07-16 10:07:28 -04:00
</header>
<main>
<ul class=grid>
$4.items
</ul>
</main>
<footer>
<a href=$@undir>all galleries</a>
</footer>
2020-07-16 10:07:28 -04:00
|]
where
2020-07-18 05:43:35 -04:00
items = map (uncurry $ makeYearItems nsfw) infosByYear
infosByYear =
2020-07-19 11:55:54 -04:00
[(the year, infopath) |
infopath@(_, info) <- infos,
then sortOn by Down info,
let year = #year info,
then group by Down year using groupBy']
groupBy' f = groupBy ((==) `on` f)
undir = joinPath (replicate (length (splitPath prefix)) "..")
2020-07-18 05:43:35 -04:00
makeYearItems :: Bool -- ^ nsfw
-> Integer -- ^ year
-> [(FilePath, Info)]
-> Builder
makeYearItems nsfw year infos = [b|@4
<li class="item year-marker">
2020-07-20 16:40:34 -04:00
<span class=year-text>$year'</span>
2020-07-18 05:43:35 -04:00
$4.items
|]
2020-07-20 16:40:34 -04:00
where
items = map (uncurry $ makeItem nsfw) infos
year' = show year & foldMap \c -> [b|<span class=y>$'c</span>|]
2020-07-16 10:07:28 -04:00
makeItem :: Bool -> FilePath -> Info -> Builder
2020-07-19 11:58:19 -04:00
makeItem nsfw file info@(Info {title}) = [b|@4
2020-07-20 16:40:34 -04:00
<li class="item post$nsfw'">
2020-07-16 10:07:28 -04:00
<figure>
<a href="$@dir">
<img src="$@thumb">
</a>
2020-07-19 11:58:19 -04:00
<figcaption>$*title</figcaption>
2020-07-16 10:07:28 -04:00
</figure>
|]
where
dir = takeDirectory file
thumb = maybe (throw $ NoThumb dir) (\t -> dir </> thumbFile t) $ #thumb info
2020-07-20 16:40:34 -04:00
nsfw' = if nsfw && #anyNsfw info then " nsfw" else ""