gallery/make-pages/Main.hs

144 lines
4.3 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 (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)
#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 $ hPutStrLn stderr $
#ifdef PRETTY_VERBOSE
ppShow x
#else
show x
#endif
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 deriving Show