start dependency stuff for single pages

This commit is contained in:
Rhiannon Morris 2020-07-15 11:45:15 +02:00
parent 3586a5b447
commit 070e2110c0
3 changed files with 91 additions and 13 deletions

43
make-pages/Depend.hs Normal file
View file

@ -0,0 +1,43 @@
module Depend where
import Info hiding (Text)
import Data.Foldable
import System.FilePath
import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (toLazyText)
import BuildVar
dependSingle' :: FilePath -- ^ yaml file name (relative to data dir!)
-> Info
-> FilePath -- ^ build dir
-> Bool -- ^ include nsfw?
-> Text
dependSingle' yaml info build nsfw =
let dir = build </> takeDirectory yaml
images = if nsfw then #images info else filter #sfw $ #images info
paths = map #path images
index = dir </> "index.html"
deps = map (dir </>) $
thumbFile (thumbnail info) : map pageFile paths ++ paths
deps' = unwords deps
in
toLazyText [b|$@index: $@deps'|]
thumbnail :: Info -> FilePath
thumbnail (Info {thumb = Just t}) = t
thumbnail (Info {images})
| Just i <- find #sfw images = #path i
| otherwise = error "no thumbnail or sfw images"
addSuffix :: String -> FilePath -> FilePath
addSuffix suf path =
let (pre, ext) = splitExtension path in
pre ++ suf ++ ext
thumbFile :: FilePath -> FilePath
thumbFile = addSuffix "_small"
pageFile :: FilePath -> FilePath
pageFile = addSuffix "_med"

View file

@ -4,13 +4,16 @@ 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 qualified Options.Applicative as Opt
import System.IO (hPutStrLn, stderr)
import System.FilePath (makeRelative)
import Text.Printf (printf)
import Control.Applicative
import Control.Monad
import SinglePage
import Depend
#ifdef PRETTY_VERBOSE
import Text.Show.Pretty (ppShow)
@ -34,6 +37,13 @@ data ModeOptions =
nsfw :: Bool,
output :: Maybe FilePath
}
| DependSingle {
file :: FilePath,
nsfw :: Bool,
output :: Maybe FilePath,
buildDir :: FilePath,
dataDir :: FilePath
}
deriving Show
optionsParser :: Opt.ParserInfo Options
@ -42,30 +52,43 @@ optionsParser = globalOpts `Opt.info` mainInfo where
verboseOpt = Opt.switch $
Opt.short 'v' <> Opt.long "verbose" <>
Opt.help "print extra stuff to stderr"
subcommands = Opt.hsubparser (single <> gallery)
subcommands = Opt.hsubparser $
single <> gallery <> dependSingle
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
singleOpts = SinglePage <$> fileArg <*> nsfwSwitchS <*> outputOpt
fileArg = Opt.strArgument $
singleOpts = SinglePage <$> file <*> nsfwS <*> output
file = Opt.strArgument $
Opt.metavar "FILE" <> Opt.help "yaml file to read"
nsfwSwitchS = Opt.switch $
nsfwS = Opt.switch $
Opt.short 'n' <> Opt.long "nsfw" <>
Opt.help "include nsfw versions"
outputOpt = Opt.option (Just <$> Opt.str) $
output = Opt.option (Just <$> Opt.str) $
Opt.short 'o' <> Opt.long "output" <> Opt.metavar "FILE" <>
Opt.value Nothing <>
Opt.help "output file (default: stdout)"
singleInfo = Opt.progDesc "generate a page for a single work"
gallery = Opt.command "gallery" $ galleryOpts `Opt.info` galleryInfo
galleryOpts = GalleryPage <$> filesArg <*> nsfwSwitchG <*> outputOpt
filesArg = many $ Opt.strArgument $
galleryOpts = GalleryPage <$> files <*> nsfwG <*> output
files = many $ Opt.strArgument $
Opt.metavar "FILE..." <> Opt.help "yaml files to read"
nsfwSwitchG = Opt.switch $
nsfwG = Opt.switch $
Opt.short 'n' <> Opt.long "nsfw" <>
Opt.help "include works with only nsfw versions"
Opt.help "include works with no sfw versions"
galleryInfo = Opt.progDesc "generate a gallery page"
dependSingle = Opt.command "depend-single" $ dsOpts `Opt.info` dsInfo
dsOpts = DependSingle <$> file <*> nsfwS <*> output <*> buildDir <*> dataDir
buildDir = Opt.strOption $
Opt.short 'B' <> Opt.long "build-dir" <> Opt.metavar "DIR" <>
Opt.value "_build" <>
Opt.help "build directory (default: _build)"
dataDir = Opt.strOption $
Opt.short 'D' <> Opt.long "data-dir" <> Opt.metavar "DIR" <>
Opt.value "data" <>
Opt.help "data directory (default: data)"
dsInfo = Opt.progDesc "generate makefile dependencies for a single page"
mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc
@ -80,13 +103,19 @@ main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do
info <- readYAML file
printV opts $ "contents" :- info
let page = make nsfw info
case output of
Nothing -> Text.putStr page
Just out -> Text.writeFile out page
writeOutput output page
main2 (Options {mode = GalleryPage {}}) = do
error "surprise! this doesn't exist yet"
main2 opts@(Options
{mode = DependSingle {file, nsfw, output, buildDir, dataDir}}) = do
info <- readYAML file
printV opts $ "contents" :- info
let path = makeRelative dataDir file
printV opts $ "path" :- path
let deps = dependSingle' path info buildDir nsfw
writeOutput output deps
printV :: Show a => Options -> a -> IO ()

View file

@ -13,7 +13,12 @@ flag pretty-verbose
executable make-pages
hs-source-dirs: .
main-is: Main.hs
other-modules: Info, SinglePage, BuildVar, Records
other-modules:
Records,
BuildVar,
Info,
SinglePage,
Depend
default-language: Haskell2010
default-extensions:
BlockArguments,
@ -35,6 +40,7 @@ executable make-pages
bytestring ^>= 0.10.8.2,
containers ^>= 0.6.0.1,
directory ^>= 1.3.6.0,
filepath ^>= 1.4.2.1,
HsYAML ^>= 0.2.1.0,
optparse-applicative ^>= 0.15.1.0,
template-haskell ^>= 2.16.0.0,