a lot of stuff sorry
This commit is contained in:
parent
adfc8b9a82
commit
375c6e833a
9 changed files with 297 additions and 151 deletions
83
Makefile
83
Makefile
|
@ -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 $< $@
|
mkdir -p $(dir $@)
|
||||||
endef
|
touch $@ # FIXME
|
||||||
|
|
||||||
ifneq ($(BUILDDIR),$(DATADIR))
|
$(MAKEPAGES): make-pages
|
||||||
$(BUILDDIR)/%: $(DATADIR)/%
|
echo "[make-pages]"
|
||||||
@$(call copy)
|
mkdir -p $(dir $@)
|
||||||
endif
|
cabal v2-build all -O0
|
||||||
|
find dist-newstyle -name make-pages -executable -type f \
|
||||||
|
-exec cp {} $@ \;
|
||||||
|
|
||||||
$(BUILDDIR)/nsfw/%: $(DATADIR)/%
|
$(TMPDIR)/galleries.d: $(DATADIR)/galleries.yaml $(MAKEPAGES)
|
||||||
@$(call copy)
|
echo "[gallery-deps] "$@
|
||||||
|
mkdir -p $(dir $@)
|
||||||
|
$(MAKEPAGES) depend-gallery $< -o $@ \
|
||||||
|
-B $(BUILDDIR) -D $(DATADIR) -T $(TMPDIR) -I $(INFONAME)
|
||||||
|
|
||||||
|
-include $(TMPDIR)/galleries.d
|
||||||
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)
|
|
||||||
|
|
||||||
.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:
|
||||||
|
|
|
@ -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|]
|
||||||
|
|
|
@ -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
58
make-pages/GalleryPage.hs
Normal 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>
|
||||||
|
|]
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
|
@ -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,
|
||||||
|
|
Loading…
Reference in a new issue