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
|
||||
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:
|
||||
|
|
|
|||
|
|
@ -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|]
|
||||
|
|
|
|||
|
|
@ -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
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 #-}
|
||||
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
|
||||
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"
|
||||
GalleryInfo <$> m .: "title"
|
||||
<*> m .: "prefix"
|
||||
<*> m .:? "filters" .!= noFilters
|
||||
<*> m .:? "ordering" .!= 0
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
module Options where
|
||||
|
||||
import Info
|
||||
import Data.Text (Text)
|
||||
import Options.Applicative
|
||||
|
||||
data Options =
|
||||
|
|
@ -18,8 +18,9 @@ data ModeOptions =
|
|||
}
|
||||
| GalleryPage {
|
||||
files :: [FilePath],
|
||||
nsfw :: Bool,
|
||||
output :: Maybe 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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 =
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
Loading…
Reference in a new issue