a lot of stuff sorry

This commit is contained in:
Rhiannon Morris 2020-07-16 16:07:28 +02:00
parent adfc8b9a82
commit 375c6e833a
9 changed files with 297 additions and 151 deletions

View file

@ -1,81 +1,44 @@
DATADIR = data DATADIR = data
TMPDIR = _tmp TMPDIR = _tmp
BUILDDIR = _build BUILDDIR = _build
INFONAME = info.yaml
# SMALL = thumbnails, MED = single pages (link to full size) # SMALL = thumbnails, MED = single pages (link to full size)
SMALL := 200 SMALL := 200
MED := 1200 MED := 1200
MAKEPAGES = cabal -v0 run -- make-pages MAKEPAGES = $(TMPDIR)/make-pages
YAMLS != find $(DATADIR) -iname "*.yaml" YAMLS != find $(DATADIR) -iname "*.yaml"
all: all: make-pages $(BUILDDIR)/index.html
define copy = $(BUILDDIR)/index.html:
echo "[copy] "$@ echo "[index]"
cp $< $@
endef
ifneq ($(BUILDDIR),$(DATADIR))
$(BUILDDIR)/%: $(DATADIR)/%
@$(call copy)
endif
$(BUILDDIR)/nsfw/%: $(DATADIR)/%
@$(call copy)
define resize =
echo "[resize] "$@
mkdir -p $(dir $@) mkdir -p $(dir $@)
convert -resize "$(1)x$(1)$(2)" $(3) $< $@ touch $@ # FIXME
endef
crop = -gravity center -crop 1:1+0 $(MAKEPAGES): make-pages
echo "[make-pages]"
$(BUILDDIR)/%_small.png: $(DATADIR)/%.png
@$(call resize,$(SMALL),^,$(crop))
$(BUILDDIR)/%_med.png: $(DATADIR)/%.png
@$(call resize,$(MED),>)
$(BUILDDIR)/nsfw/%_small.png: $(DATADIR)/%.png
@$(call resize,$(SMALL),^,$(crop))
$(BUILDDIR)/nsfw/%_med.png: $(DATADIR)/%.png
@$(call resize,$(MED),>)
define single =
echo "[single] "$@
mkdir -p $(dir $@) mkdir -p $(dir $@)
$(MAKEPAGES) single $< -o $@ $(1) cabal v2-build all -O0
endef find dist-newstyle -name make-pages -executable -type f \
-exec cp {} $@ \;
$(BUILDDIR)/%/index.html: $(DATADIR)/%/info.yaml $(TMPDIR)/galleries.d: $(DATADIR)/galleries.yaml $(MAKEPAGES)
@$(call single) echo "[gallery-deps] "$@
$(BUILDDIR)/nsfw/%/index.html: $(DATADIR)/%/info.yaml
@$(call single,-n)
define depend-single =
echo "[deps] "$@
mkdir -p $(dir $@) mkdir -p $(dir $@)
$(MAKEPAGES) depend-single $< -o $@ $(1) $(MAKEPAGES) depend-gallery $< -o $@ \
endef -B $(BUILDDIR) -D $(DATADIR) -T $(TMPDIR) -I $(INFONAME)
$(TMPDIR)/%.d: %.yaml -include $(TMPDIR)/galleries.d
@$(call depend-single)
$(TMPDIR)/nsfw/%.d: %.yaml
@$(call depend-single,-n -p nsfw)
include $(TMPDIR)/$(YAMLS:.yaml=.d)
include $(TMPDIR)/nsfw/$(YAMLS:.yaml=.d)
.PHONY: clean distclean .PHONY: clean distclean
clean: clean:
echo "[clean]"
rm -rf $(BUILDDIR) $(TMPDIR) rm -rf $(BUILDDIR) $(TMPDIR)
distclean: clean distclean: clean
echo "[distclean]"
rm -rf dist-newstyle rm -rf dist-newstyle
.SILENT:

View file

@ -4,6 +4,7 @@ module BuilderQQ (b) where
import Data.Char (isLower, isSpace, isDigit, isAlphaNum) import Data.Char (isLower, isSpace, isDigit, isAlphaNum)
import Language.Haskell.TH import Language.Haskell.TH
import Language.Haskell.TH.Quote import Language.Haskell.TH.Quote
import Data.Maybe (mapMaybe)
import Data.Text.Lazy.Builder import Data.Text.Lazy.Builder
(Builder, fromText, fromString, singleton, toLazyText) (Builder, fromText, fromString, singleton, toLazyText)
import Text.Read (readMaybe) import Text.Read (readMaybe)
@ -18,6 +19,7 @@ data VarType =
Plain Plain
| FromText | FromText
| FromString | FromString
| FromChar
| Show | Show
| Reindent !Int | Reindent !Int
| ReindentList !Int | ReindentList !Int
@ -72,6 +74,11 @@ chunks = reverse . go "" [] . trimEnd where
go "" ((Var FromString, var) : lit acc : cs) rest2 go "" ((Var FromString, var) : lit acc : cs) rest2
where (var, rest2) = splitVar rest where (var, rest2) = splitVar rest
-- $'var: expands to (singleton $var)
go acc cs ('$' :. '\'' :. rest) =
go "" ((Var FromChar, var) : lit acc : cs) rest2
where (var, rest2) = splitVar rest
-- $^var: expands to (fromString (show $var)) -- $^var: expands to (fromString (show $var))
go acc cs ('$' :. '^' :. rest) = go acc cs ('$' :. '^' :. rest) =
go "" ((Var Show, var) : lit acc : cs) rest2 go "" ((Var Show, var) : lit acc : cs) rest2
@ -98,8 +105,8 @@ chunks = reverse . go "" [] . trimEnd where
go acc cs (c :. rest) = go (acc <> singleton c) cs rest go acc cs (c :. rest) = go (acc <> singleton c) cs rest
splitVar s splitVar s
| (var, s') <- Text.span isIdChar s, | (var@(v :. _), s') <- Text.span isIdChar s,
isLower (Text.head var) isLower v
= (var, s') = (var, s')
splitVar _ = error "invalid variable name" splitVar _ = error "invalid variable name"
@ -121,13 +128,15 @@ toStrictText = toStrict . toLazyText
chunksToExpQ :: [Chunk] -> ExpQ chunksToExpQ :: [Chunk] -> ExpQ
chunksToExpQ cs = [|$expr :: Builder|] where chunksToExpQ cs = [|mconcat $es|] where
expr = foldl1 (\x y -> [|$x <> $y|]) $ map chunk1 cs es = listE $ mapMaybe chunk1 cs
chunk1 (Lit, lit) = stringE $ Text.unpack lit chunk1 (Lit, "") = Nothing
chunk1 (Var t, name) = case t of chunk1 (Lit, lit) = Just $ stringE $ Text.unpack lit
chunk1 (Var t, name) = Just $ case t of
Plain -> var Plain -> var
FromText -> [|fromText $var|] FromText -> [|fromText $var|]
FromString -> [|fromString $var|] FromString -> [|fromString $var|]
FromChar -> [|singleton $var|]
Show -> [|fromString $ show $var|] Show -> [|fromString $ show $var|]
Reindent n -> [|reindent n $var|] Reindent n -> [|reindent n $var|]
ReindentList n -> [|reindentList n $var|] ReindentList n -> [|reindentList n $var|]

View file

@ -1,11 +1,15 @@
module Depend where module Depend
(dependSingle, dependSingle',
dependGallery, dependGallery',
thumbFile, pageFile)
where
import BuilderQQ import BuilderQQ
import Info hiding (Text) import Info hiding (Text)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Text.Lazy (Text) import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder (Builder, toLazyText, fromString)
import System.FilePath import System.FilePath
@ -15,16 +19,100 @@ dependSingle :: FilePath -- ^ yaml file name (relative to data dir!)
-> FilePath -- ^ build dir -> FilePath -- ^ build dir
-> Bool -- ^ include nsfw? -> Bool -- ^ include nsfw?
-> Text -> Text
dependSingle yaml info prefix build nsfw = dependSingle yamlDir info prefix build nsfw =
let dir = build </> prefix </> takeDirectory yaml toLazyText $ dependSingle' yamlDir info prefix build nsfw
dependSingle' :: FilePath -> Info -> FilePath -> FilePath -> Bool -> Builder
dependSingle' yamlDir info prefix build nsfw =
let dir = build </> prefix </> yamlDir
images = if nsfw then #images info else #sfwImages info images = if nsfw then #images info else #sfwImages info
paths = map #path images paths = map #path images
index = dir </> "index.html" index = dir </> "index.html"
deps = thumbFile (thumbnail info) : map pageFile paths ++ paths deps = thumbFile (thumbnail info) : map pageFile paths ++ paths
deps' = unwords $ map (dir </>) deps deps' = unwords $ map (dir </>) deps
in in
toLazyText [b|$@index: $@deps'|] [b|$@index: $@deps'|]
dependGallery :: GalleryInfo
-> [(FilePath, Info)] -- ^ relative to data dir
-> FilePath -- ^ build dir
-> FilePath -- ^ data dir
-> FilePath -- ^ tmp dir
-> Text
dependGallery ginfo infos build data_ tmp =
toLazyText $ dependGallery' ginfo infos build data_ tmp
dependGallery' :: GalleryInfo -> [(FilePath, Info)]
-> FilePath -> FilePath -> FilePath -> Builder
dependGallery' (GalleryInfo {title, prefix, filters}) infos' build data_ tmp =
let infos = filter (matchFilters filters . snd) infos'
files = map fst infos
files' = unwords $ map (data_ </>) files
page d = build </> prefix </> takeDirectory d </> "index.html"
pages = map (page . fst) infos
pages' = unwords pages
path = build </> prefix </> "index.html"
rules = makeRules prefix filters build data_ tmp
inc d = tmp </> prefix </> takeDirectory d <.> "d"
incs = if null infos then "" else
"include " <> fromString (unwords $ map inc files)
index = build </> "index.html"
in [b|@0
$@index: $@path
$@path: $@pages'
$@path: $@files'
echo "[gallery] "$$@
mkdir -p $$(dir $$@)
$$(MAKEPAGES) gallery -t "$*title" -o "$$@" $$<
$rules
$incs
|]
makeRules :: FilePath -- ^ prefix
-> GalleryFilters
-> FilePath -- ^ build dir
-> FilePath -- ^ data dir
-> FilePath -- ^ tmp dir
-> Builder
makeRules prefix filters build data_ tmp = [b|@0
$@buildPrefix/%/index.html: $@data_/%/info.yaml
echo "[single] "$$@
mkdir -p $$(dir $$@)
$$(MAKEPAGES) single "$$<" -o "$$@" $flags
$@tmpPrefix/%.d: $@data_/%/info.yaml
echo "[deps] "$$@
mkdir -p $$(dir $$@)
$$(MAKEPAGES) depend-single $flags \
-o "$$@" -p "$@prefix" -B "$@build" -D "$@data_" $$<
$@buildPrefix/%: $@data_/%
echo "[copy] "$$@
mkdir -p $$(dir $$@)
cp "$$<" "$$@"
$@buildPrefix/%_small.png: $@data_/%.png
echo "[resize] "$$@
mkdir -p $$(dir $$@)
convert -resize '$$(SMALL)x$$(SMALL)^' \
-gravity center -crop 1:1+0 "$$<" "$$@"
$@buildPrefix/%_med.png: $@data_/%.png
echo "[resize] "$$@
mkdir -p $$(dir $$@)
convert -resize '$$(MED)x$$(MED)>' "$$<" "$$@"
|]
where
buildPrefix = build </> prefix
tmpPrefix = tmp </> prefix
flags = filtersToFlags filters
filtersToFlags :: GalleryFilters -> Builder
filtersToFlags (GalleryFilters {nsfw}) =
case nsfw of Just False -> ""; _ -> "-n"
thumbnail :: Info -> FilePath thumbnail :: Info -> FilePath
thumbnail = fromMaybe (error "no thumbnail or sfw images") . #thumb thumbnail = fromMaybe (error "no thumbnail or sfw images") . #thumb

58
make-pages/GalleryPage.hs Normal file
View file

@ -0,0 +1,58 @@
module GalleryPage (make) where
import Control.Exception
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 -> [(FilePath, Info)] -> Lazy.Text
make title infos = toLazyText $ make' title infos
make' :: Text -> [(FilePath, Info)] -> Builder
make' title infos = [b|
<!DOCTYPE html>
<html lang=en>
<meta charset=utf-8>
<title>$*title</title>
<header>
<h1>$*title</h1>
</header>
<main>
<ul class=grid>
$4.items
</ul>
</main>
|]
where
items = map (uncurry makeItem) infos
makeItem :: FilePath -> Info -> Builder
makeItem file info = [b|@4
<li class=item>
<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>
|]

View file

@ -1,8 +1,8 @@
{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
module Info module Info
(Info (..), Artist (..), Image (..), Link (..), (Info (..), Artist (..), Image (..), Link (..),
GalleryInfo (..), GalleryFilters, Who (..), GalleryInfo (..), GalleryFilters (..), Whose (..),
readWho, matchWho, matchNsfw, matchFilters, readWhose, matchWhose, matchNsfw, matchFilters,
-- ** Reexports -- ** Reexports
Day (..), Text) Day (..), Text)
where where
@ -103,59 +103,57 @@ instance FromYAML Link where
data GalleryInfo = data GalleryInfo =
GalleryInfo { GalleryInfo {
title :: !Text,
prefix :: !FilePath, prefix :: !FilePath,
name :: !Text, filters :: !GalleryFilters
filters :: !GalleryFilters,
ordering :: !Int -- sorted by @ordering@ on gallery list page
} }
deriving (Eq, Show) deriving (Eq, Show)
data GalleryFilters = data GalleryFilters =
GalleryFilters { GalleryFilters {
nsfw :: Maybe Bool, nsfw :: Maybe Bool,
who :: Who whose :: Whose
} }
deriving (Eq, Show) deriving (Eq, Show)
data Who = Mine | NotMine | All deriving (Eq, Show) data Whose = Mine | NotMine | All deriving (Eq, Show)
matchNsfw :: Maybe Bool -> Info -> Bool matchNsfw :: Maybe Bool -> Info -> Bool
matchNsfw Nothing _ = True matchNsfw Nothing _ = True
matchNsfw (Just nsfw) i = #allNsfw i == nsfw matchNsfw (Just nsfw) i = #allNsfw i == nsfw
readWho :: (IsString str, Eq str, Alternative f) => str -> f Who readWhose :: (IsString str, Eq str, Alternative f) => str -> f Whose
readWho "mine" = pure Mine readWhose "mine" = pure Mine
readWho "not-mine" = pure NotMine readWhose "not-mine" = pure NotMine
readWho "all" = pure All readWhose "all" = pure All
readWho _ = empty readWhose _ = empty
matchWho :: Who -> Info -> Bool matchWhose :: Whose -> Info -> Bool
matchWho Mine = #mine matchWhose Mine = #mine
matchWho NotMine = #notMine matchWhose NotMine = #notMine
matchWho All = const True matchWhose All = const True
noFilters :: GalleryFilters noFilters :: GalleryFilters
noFilters = GalleryFilters {nsfw = Nothing, who = All} noFilters = GalleryFilters {nsfw = Nothing, whose = All}
matchFilters :: GalleryFilters -> Info -> Bool matchFilters :: GalleryFilters -> Info -> Bool
matchFilters (GalleryFilters {nsfw, who}) i = matchFilters (GalleryFilters {nsfw, whose}) i =
matchNsfw nsfw i && matchWho who i matchNsfw nsfw i && matchWhose whose i
instance FromYAML GalleryInfo where instance FromYAML GalleryInfo where
parseYAML = YAML.withMap "gallery info" \m -> parseYAML = YAML.withMap "gallery info" \m ->
GalleryInfo <$> m .: "prefix" GalleryInfo <$> m .: "title"
<*> m .: "name" <*> m .: "prefix"
<*> m .:? "filters" .!= noFilters <*> m .:? "filters" .!= noFilters
<*> m .:? "ordering" .!= 0
instance FromYAML GalleryFilters where instance FromYAML GalleryFilters where
parseYAML = YAML.withMap "gallery filters" \m -> parseYAML = YAML.withMap "gallery filters" \m ->
GalleryFilters <$> m .:? "nsfw" GalleryFilters <$> m .:? "nsfw"
<*> m .:? "who" .!= All <*> m .:? "whose" .!= All
instance FromYAML Who where parseYAML = YAML.withStr "who" readWho instance FromYAML Whose where parseYAML = YAML.withStr "whose" readWhose
data Pair a b = Pair !a !b data Pair a b = Pair !a !b

View file

@ -1,22 +1,27 @@
{-# LANGUAGE CPP, ImplicitParams #-} {-# LANGUAGE CPP, ImplicitParams, TypeApplications #-}
module Main (main) where module Main (main) where
import qualified Data.ByteString.Lazy as ByteString
import Data.ByteString.Lazy (ByteString)
import qualified Data.YAML as YAML
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy.IO as Text
import System.IO (hPrint, stderr)
import System.FilePath (makeRelative)
import Control.Monad import Control.Monad
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as ByteString
import Data.List (intersperse)
import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (toLazyText)
import qualified Data.Text.Lazy.IO as Text
import qualified Data.YAML as YAML
import System.FilePath (makeRelative, takeDirectory)
import System.FilePath.Find (find, always, fileName, (==?))
import System.IO (hPrint, stderr)
import Options
import SinglePage
import Depend import Depend
import Info (Info)
import Options
import qualified SinglePage
import qualified GalleryPage
#ifdef PRETTY_VERBOSE #ifdef PRETTY_VERBOSE
import qualified Text.Show.Pretty as PP
import qualified Text.PrettyPrint as PP import qualified Text.PrettyPrint as PP
import qualified Text.Show.Pretty as PP
#endif #endif
@ -40,22 +45,41 @@ main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {file, nsfw, output}) = do main2 (SinglePage {file, nsfw, output}) = do
info <- readYAML file info <- readYAML file
printV $ "contents" := info printV $ "contents" := info
let page = make nsfw info let page = SinglePage.make nsfw info
writeOutput output page writeOutput output page
main2 (GalleryPage {}) = do main2 (GalleryPage {title, files, output, dataDir}) = do
error "surprise! this doesn't exist yet" infos <- mapM (infoYAML dataDir) files
printV $ "infos" := infos
let page = GalleryPage.make title infos
writeOutput output page
main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do
info <- readYAML file info <- readYAML file
printV $ "contents" := info printV $ "contents" := info
let path = makeRelative dataDir file let dir = takeDirectory $ makeRelative dataDir file
printV $ "path" := path printV $ "dir" := dir
let deps = dependSingle path info prefix buildDir nsfw let deps = dependSingle dir info prefix buildDir nsfw
writeOutput output deps writeOutput output deps
main2 (DependGallery {}) = do main2 (DependGallery {file, output, buildDir, dataDir, tmpDir, infoName}) = do
error "surprise! this doesn't exist yet" ginfos <- readYAML @[_] file
printV $ "galleries" := ginfos
infos <- mapM (infoYAML dataDir) =<<
find always (fileName ==? infoName) dataDir
printV $ "info files" := infos
let dependGallery0 g = dependGallery' g infos buildDir dataDir tmpDir
let deps = toLazyText $ mconcat $ intersperse "\n\n\n" $
map dependGallery0 ginfos
writeOutput output deps
infoYAML :: FilePath -- ^ data dir
-> FilePath -- ^ yaml file
-> IO (FilePath, Info) -- relative filename, contents
infoYAML dataDir f = do
let f' = makeRelative dataDir f
info <- readYAML f
pure (f', info)
readYAML :: YAML.FromYAML a => FilePath -> IO a readYAML :: YAML.FromYAML a => FilePath -> IO a

View file

@ -1,6 +1,6 @@
module Options where module Options where
import Info import Data.Text (Text)
import Options.Applicative import Options.Applicative
data Options = data Options =
@ -18,8 +18,9 @@ data ModeOptions =
} }
| GalleryPage { | GalleryPage {
files :: [FilePath], files :: [FilePath],
nsfw :: Bool, title :: Text,
output :: Maybe FilePath output :: Maybe FilePath,
dataDir :: FilePath
} }
| DependSingle { | DependSingle {
file :: FilePath, file :: FilePath,
@ -30,13 +31,12 @@ data ModeOptions =
dataDir :: FilePath dataDir :: FilePath
} }
| DependGallery { | DependGallery {
prefix :: FilePath, file :: FilePath,
files :: [FilePath],
nsfw :: Bool,
who :: Who,
output :: Maybe FilePath, output :: Maybe FilePath,
buildDir :: FilePath, buildDir :: FilePath,
dataDir :: FilePath dataDir :: FilePath,
tmpDir :: FilePath,
infoName :: FilePath
} }
deriving Show deriving Show
@ -64,12 +64,12 @@ optionsParser = globalOpts `info` mainInfo where
singleInfo = progDesc "generate a page for a single work" singleInfo = progDesc "generate a page for a single work"
gallery = command "gallery" $ galleryOpts `info` galleryInfo gallery = command "gallery" $ galleryOpts `info` galleryInfo
galleryOpts = GalleryPage <$> files <*> nsfwG <*> output galleryOpts = GalleryPage <$> files <*> title <*> output <*> dataDir
files = many $ strArgument $ files = many $ strArgument $
metavar "FILE..." <> help "yaml files to read" metavar "FILE..." <> help "yaml files to read"
nsfwG = switch $ title = strOption $
short 'n' <> long "nsfw" <> short 't' <> long "title" <> metavar "TITLE" <>
help "include works with no sfw versions" help "page title"
galleryInfo = progDesc "generate a gallery page" galleryInfo = progDesc "generate a gallery page"
dependSingle = command "depend-single" $ dsOpts `info` dsInfo dependSingle = command "depend-single" $ dsOpts `info` dsInfo
@ -81,26 +81,24 @@ optionsParser = globalOpts `info` mainInfo where
value "" <> value "" <>
help "output directory prefix" help "output directory prefix"
buildDir = strOption $ buildDir = strOption $
short 'B' <> long "build-dir" <> metavar "DIR" <> short 'B' <> long "build-dir" <> metavar "DIR" <> value "_build" <>
value "_build" <>
help "build directory (default: _build)" help "build directory (default: _build)"
dataDir = strOption $ dataDir = strOption $
short 'D' <> long "data-dir" <> metavar "DIR" <> short 'D' <> long "data-dir" <> metavar "DIR" <> value "data" <>
value "data" <>
help "data directory (default: data)" help "data directory (default: data)"
dsInfo = progDesc "generate makefile dependencies for a single page" dsInfo = progDesc "generate makefile dependencies for a single page"
dependGallery = command "depend-gallery" $ dgOpts `info` dgInfo dependGallery = command "depend-gallery" $ dgOpts `info` dgInfo
dgOpts = dgOpts =
DependGallery <$> prefixArg <*> files <*> nsfwG <*> who DependGallery <$> file <*> output
<*> output <*> buildDir <*> dataDir <*> buildDir <*> dataDir <*> tmpDir <*> infoName
prefixArg = strArgument $ infoName = strOption $
metavar "PREFIX" <> help "target directory" short 'I' <> long "info" <> metavar "NAME" <>
who = option (maybeReader readWho) $ value "info.yaml" <>
short 'w' <> long "who" <> help "filename of artwork info files (default: info.yaml)"
metavar "mine|not-mine|all" <> tmpDir = strOption $
value All <> short 'T' <> long "tmp-dir" <> metavar "DIR" <> value "_tmp" <>
help "select by artist" help "temporary directory (default: _tmp)"
dgInfo = progDesc "generate makefile dependencies for a gallery" dgInfo = progDesc "generate makefile dependencies for a gallery"
mainInfo = progDesc "static gallery site generator" <> fullDesc mainInfo = progDesc "static gallery site generator" <> fullDesc

View file

@ -1,13 +1,14 @@
module SinglePage (make) where module SinglePage (make) where
import Records () import Depend (pageFile)
import Info hiding (Text) import Info hiding (Text)
import BuilderQQ import BuilderQQ
import Records ()
import Control.Exception import Control.Exception
import qualified Data.Text as Strict import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder import Data.Text.Lazy.Builder (Builder, toLazyText)
import Data.Time (formatTime, defaultTimeLocale) import Data.Time (formatTime, defaultTimeLocale)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Data.Char as Char import qualified Data.Char as Char
@ -43,7 +44,9 @@ make' nsfw (Info {date, title, artist, tags, nsfwTags,
</header> </header>
<main> <main>
<img id=it src="$@path0"> <a href="$@path0">
<img id=it src="$@path0'">
</a>
$descSection $descSection
@ -68,6 +71,7 @@ make' nsfw (Info {date, title, artist, tags, nsfwTags,
buttonBar = makeButtonBar (fromMaybe (Strict.pack path0) title) nsfw images buttonBar = makeButtonBar (fromMaybe (Strict.pack path0) title) nsfw images
path0 = #path $ head images path0 = #path $ head images
path0' = pageFile path0
descSection = ifJust description makeDesc descSection = ifJust description makeDesc
tagsList = makeTags nsfw tags nsfwTags tagsList = makeTags nsfw tags nsfwTags
@ -93,7 +97,8 @@ ifJust :: Monoid b => Maybe a -> (a -> b) -> b
ifJust x f = maybe mempty f x ifJust x f = maybe mempty f x
formatDate :: Day -> Builder formatDate :: Day -> Builder
formatDate = fromString . formatTime defaultTimeLocale "%e %#B %Y" formatDate d =
let str = formatTime defaultTimeLocale "%e %#B %Y" d in [b|$@str|]
makeButtonBar :: Strict.Text -> Bool -> [Image] -> Builder makeButtonBar :: Strict.Text -> Bool -> [Image] -> Builder
makeButtonBar title nsfw allImages = makeButtonBar title nsfw allImages =
@ -117,20 +122,21 @@ altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw}) = [b|@6 altButton i (Image {label, path, nsfw}) = [b|@6
<li$nsfwClass> <li$nsfwClass>
<input type=radio$checked id="$idLabel" name=variant <input type=radio$checked id="$idLabel" name=variant
autocomplete=off value="$@path"> autocomplete=off value="$@path'">
<label for="$idLabel">$*label</label> <label for="$idLabel">$*label</label>
|] |]
where where
nsfwClass = if nsfw then " class=nsfw" else "" nsfwClass = if nsfw then " class=nsfw" else ""
checked = if i == 0 then " checked" else "" checked = if i == 0 then " checked" else ""
idLabel = escId label idLabel = escId label
path' = pageFile path
escId :: Strict.Text -> Builder escId :: Strict.Text -> Builder
escId = foldMap esc1 . Strict.unpack where escId = foldMap esc1 . Strict.unpack where
esc1 c esc1 c
| Char.isSpace c = "" | Char.isSpace c = ""
| c < 'ÿ' && not (Char.isAlphaNum c || c == '-') = "_" | c < 'ÿ' && not (Char.isAlphaNum c || c == '-') = "_"
| otherwise = singleton c | otherwise = [b|$'c|]
makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder
makeTags nsfw sfwTags nsfwTags = makeTags nsfw sfwTags nsfwTags =

View file

@ -18,6 +18,7 @@ executable make-pages
BuilderQQ, BuilderQQ,
Info, Info,
SinglePage, SinglePage,
GalleryPage,
Depend, Depend,
Options Options
default-language: Haskell2010 default-language: Haskell2010
@ -35,13 +36,14 @@ executable make-pages
PatternSynonyms, PatternSynonyms,
QuasiQuotes, QuasiQuotes,
RankNTypes, RankNTypes,
TupleSections,
TypeSynonymInstances, TypeSynonymInstances,
ViewPatterns ViewPatterns
build-depends: build-depends:
base >= 4.12.0.0 && < 4.15, base >= 4.12.0.0 && < 4.15,
bytestring ^>= 0.10.8.2, bytestring ^>= 0.10.8.2,
containers ^>= 0.6.0.1, containers ^>= 0.6.0.1,
directory ^>= 1.3.6.0, filemanip ^>= 0.3.6.3,
filepath ^>= 1.4.2.1, filepath ^>= 1.4.2.1,
HsYAML ^>= 0.2.1.0, HsYAML ^>= 0.2.1.0,
optparse-applicative ^>= 0.15.1.0, optparse-applicative ^>= 0.15.1.0,