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

View File

@ -4,6 +4,7 @@ module BuilderQQ (b) where
import Data.Char (isLower, isSpace, isDigit, isAlphaNum)
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Data.Maybe (mapMaybe)
import Data.Text.Lazy.Builder
(Builder, fromText, fromString, singleton, toLazyText)
import Text.Read (readMaybe)
@ -18,6 +19,7 @@ data VarType =
Plain
| FromText
| FromString
| FromChar
| Show
| Reindent !Int
| ReindentList !Int
@ -72,6 +74,11 @@ chunks = reverse . go "" [] . trimEnd where
go "" ((Var FromString, var) : lit acc : cs) rest2
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))
go acc cs ('$' :. '^' :. rest) =
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
splitVar s
| (var, s') <- Text.span isIdChar s,
isLower (Text.head var)
| (var@(v :. _), s') <- Text.span isIdChar s,
isLower v
= (var, s')
splitVar _ = error "invalid variable name"
@ -121,13 +128,15 @@ toStrictText = toStrict . toLazyText
chunksToExpQ :: [Chunk] -> ExpQ
chunksToExpQ cs = [|$expr :: Builder|] where
expr = foldl1 (\x y -> [|$x <> $y|]) $ map chunk1 cs
chunk1 (Lit, lit) = stringE $ Text.unpack lit
chunk1 (Var t, name) = case t of
chunksToExpQ cs = [|mconcat $es|] where
es = listE $ mapMaybe chunk1 cs
chunk1 (Lit, "") = Nothing
chunk1 (Lit, lit) = Just $ stringE $ Text.unpack lit
chunk1 (Var t, name) = Just $ case t of
Plain -> var
FromText -> [|fromText $var|]
FromString -> [|fromString $var|]
FromChar -> [|singleton $var|]
Show -> [|fromString $ show $var|]
Reindent n -> [|reindent 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 Info hiding (Text)
import Data.Maybe (fromMaybe)
import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Builder (Builder, toLazyText, fromString)
import System.FilePath
@ -15,16 +19,100 @@ dependSingle :: FilePath -- ^ yaml file name (relative to data dir!)
-> FilePath -- ^ build dir
-> Bool -- ^ include nsfw?
-> Text
dependSingle yaml info prefix build nsfw =
let dir = build </> prefix </> takeDirectory yaml
dependSingle yamlDir info prefix build nsfw =
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
paths = map #path images
index = dir </> "index.html"
deps = thumbFile (thumbnail info) : map pageFile paths ++ paths
deps' = unwords $ map (dir </>) deps
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 = 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 #-}
module Info
(Info (..), Artist (..), Image (..), Link (..),
GalleryInfo (..), GalleryFilters, Who (..),
readWho, matchWho, matchNsfw, matchFilters,
GalleryInfo (..), GalleryFilters (..), Whose (..),
readWhose, matchWhose, matchNsfw, matchFilters,
-- ** Reexports
Day (..), Text)
where
@ -103,59 +103,57 @@ instance FromYAML Link where
data GalleryInfo =
GalleryInfo {
title :: !Text,
prefix :: !FilePath,
name :: !Text,
filters :: !GalleryFilters,
ordering :: !Int -- sorted by @ordering@ on gallery list page
filters :: !GalleryFilters
}
deriving (Eq, Show)
data GalleryFilters =
GalleryFilters {
nsfw :: Maybe Bool,
who :: Who
nsfw :: Maybe Bool,
whose :: Whose
}
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 Nothing _ = True
matchNsfw (Just nsfw) i = #allNsfw i == nsfw
readWho :: (IsString str, Eq str, Alternative f) => str -> f Who
readWho "mine" = pure Mine
readWho "not-mine" = pure NotMine
readWho "all" = pure All
readWho _ = empty
readWhose :: (IsString str, Eq str, Alternative f) => str -> f Whose
readWhose "mine" = pure Mine
readWhose "not-mine" = pure NotMine
readWhose "all" = pure All
readWhose _ = empty
matchWho :: Who -> Info -> Bool
matchWho Mine = #mine
matchWho NotMine = #notMine
matchWho All = const True
matchWhose :: Whose -> Info -> Bool
matchWhose Mine = #mine
matchWhose NotMine = #notMine
matchWhose All = const True
noFilters :: GalleryFilters
noFilters = GalleryFilters {nsfw = Nothing, who = All}
noFilters = GalleryFilters {nsfw = Nothing, whose = All}
matchFilters :: GalleryFilters -> Info -> Bool
matchFilters (GalleryFilters {nsfw, who}) i =
matchNsfw nsfw i && matchWho who i
matchFilters (GalleryFilters {nsfw, whose}) i =
matchNsfw nsfw i && matchWhose whose i
instance FromYAML GalleryInfo where
parseYAML = YAML.withMap "gallery info" \m ->
GalleryInfo <$> m .: "prefix"
<*> m .: "name"
<*> m .:? "filters" .!= noFilters
<*> m .:? "ordering" .!= 0
GalleryInfo <$> m .: "title"
<*> m .: "prefix"
<*> m .:? "filters" .!= noFilters
instance FromYAML GalleryFilters where
parseYAML = YAML.withMap "gallery filters" \m ->
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

View File

@ -1,22 +1,27 @@
{-# LANGUAGE CPP, ImplicitParams #-}
{-# LANGUAGE CPP, ImplicitParams, TypeApplications #-}
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 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 Info (Info)
import Options
import qualified SinglePage
import qualified GalleryPage
#ifdef PRETTY_VERBOSE
import qualified Text.Show.Pretty as PP
import qualified Text.PrettyPrint as PP
import qualified Text.Show.Pretty as PP
#endif
@ -40,22 +45,41 @@ main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {file, nsfw, output}) = do
info <- readYAML file
printV $ "contents" := info
let page = make nsfw info
let page = SinglePage.make nsfw info
writeOutput output page
main2 (GalleryPage {}) = do
error "surprise! this doesn't exist yet"
main2 (GalleryPage {title, files, output, dataDir}) = do
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
info <- readYAML file
printV $ "contents" := info
let path = makeRelative dataDir file
printV $ "path" := path
let deps = dependSingle path info prefix buildDir nsfw
let dir = takeDirectory $ makeRelative dataDir file
printV $ "dir" := dir
let deps = dependSingle dir info prefix buildDir nsfw
writeOutput output deps
main2 (DependGallery {}) = do
error "surprise! this doesn't exist yet"
main2 (DependGallery {file, output, buildDir, dataDir, tmpDir, infoName}) = do
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

View File

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

View File

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

View File

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