148 lines
4.4 KiB
Haskell
148 lines
4.4 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
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 (hPrint, stderr)
|
|
import System.FilePath (makeRelative)
|
|
import Text.Printf (printf)
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import SinglePage
|
|
import Depend
|
|
|
|
#ifdef PRETTY_VERBOSE
|
|
import qualified Text.Show.Pretty as PP
|
|
import qualified Text.PrettyPrint as PP
|
|
#endif
|
|
|
|
data Options =
|
|
Options {
|
|
verbose :: Bool,
|
|
mode :: ModeOptions
|
|
}
|
|
deriving Show
|
|
|
|
data ModeOptions =
|
|
SinglePage {
|
|
file :: FilePath,
|
|
nsfw :: Bool,
|
|
output :: Maybe FilePath
|
|
}
|
|
| GalleryPage {
|
|
files :: [FilePath],
|
|
nsfw :: Bool,
|
|
output :: Maybe FilePath
|
|
}
|
|
| DependSingle {
|
|
file :: FilePath,
|
|
nsfw :: Bool,
|
|
output :: Maybe FilePath,
|
|
buildDir :: FilePath,
|
|
dataDir :: FilePath
|
|
}
|
|
deriving Show
|
|
|
|
optionsParser :: Opt.ParserInfo Options
|
|
optionsParser = globalOpts `Opt.info` mainInfo where
|
|
globalOpts = Options <$> verboseOpt <*> subcommands <**> Opt.helper
|
|
verboseOpt = Opt.switch $
|
|
Opt.short 'v' <> Opt.long "verbose" <>
|
|
Opt.help "print extra stuff to stderr"
|
|
subcommands = Opt.hsubparser $
|
|
single <> gallery <> dependSingle
|
|
|
|
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
|
|
singleOpts = SinglePage <$> file <*> nsfwS <*> output
|
|
file = Opt.strArgument $
|
|
Opt.metavar "FILE" <> Opt.help "yaml file to read"
|
|
nsfwS = Opt.switch $
|
|
Opt.short 'n' <> Opt.long "nsfw" <>
|
|
Opt.help "include nsfw versions"
|
|
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 <$> files <*> nsfwG <*> output
|
|
files = many $ Opt.strArgument $
|
|
Opt.metavar "FILE..." <> Opt.help "yaml files to read"
|
|
nsfwG = Opt.switch $
|
|
Opt.short 'n' <> Opt.long "nsfw" <>
|
|
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
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
opts <- Opt.execParser optionsParser
|
|
printV opts $ "options" :- opts
|
|
main2 opts
|
|
|
|
main2 :: Options -> IO ()
|
|
main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do
|
|
info <- readYAML file
|
|
printV opts $ "contents" :- info
|
|
let page = make nsfw info
|
|
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 ()
|
|
printV (Options {verbose}) x = when verbose $ hPrint stderr x
|
|
|
|
readYAML :: YAML.FromYAML a => FilePath -> IO a
|
|
readYAML file = ByteString.readFile file >>= decode1Must file
|
|
|
|
decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a
|
|
decode1Must file txt =
|
|
case YAML.decode1 txt of
|
|
Right val -> pure val
|
|
Left (YAML.Pos {posLine, posColumn}, err) ->
|
|
fail $ printf "%s:%i:%i: %s" file posLine posColumn err
|
|
|
|
writeOutput :: Maybe FilePath -> Text -> IO ()
|
|
writeOutput (Just f) = Text.writeFile f
|
|
writeOutput Nothing = Text.putStrLn
|
|
|
|
data Tag a = String :- a
|
|
|
|
instance Show a => Show (Tag a) where
|
|
show (tag :- a) =
|
|
#ifdef PRETTY_VERBOSE
|
|
PP.render $ PP.hang (PP.text tag <> ":") 2 (PP.ppDoc a)
|
|
#else
|
|
tag ++ ": " ++ show a
|
|
#endif
|