gallery/make-pages/Main.hs

145 lines
4.3 KiB
Haskell
Raw Normal View History

2020-07-15 05:43:57 -04:00
{-# LANGUAGE CPP #-}
2020-07-07 18:21:08 -04:00
module Main (main) where
import qualified Data.ByteString.Lazy as ByteString
2020-07-12 23:01:57 -04:00
import Data.ByteString.Lazy (ByteString)
import qualified Data.YAML as YAML
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy.IO as Text
2020-07-09 00:20:57 -04:00
import qualified Options.Applicative as Opt
2020-07-15 05:43:57 -04:00
import System.IO (hPutStrLn, stderr)
import System.FilePath (makeRelative)
import Text.Printf (printf)
2020-07-09 00:20:57 -04:00
import Control.Applicative
2020-07-12 23:01:57 -04:00
import Control.Monad
2020-07-09 00:20:57 -04:00
import SinglePage
import Depend
2020-07-09 00:20:57 -04:00
2020-07-15 05:43:57 -04:00
#ifdef PRETTY_VERBOSE
import Text.Show.Pretty (ppShow)
#endif
2020-07-09 00:20:57 -04:00
data Options =
2020-07-12 23:01:57 -04:00
Options {
verbose :: Bool,
mode :: ModeOptions
}
deriving Show
data ModeOptions =
2020-07-09 00:20:57 -04:00
SinglePage {
2020-07-13 02:32:59 -04:00
file :: FilePath,
nsfw :: Bool,
output :: Maybe FilePath
2020-07-09 00:20:57 -04:00
}
| GalleryPage {
2020-07-13 02:32:59 -04:00
files :: [FilePath],
nsfw :: Bool,
output :: Maybe FilePath
2020-07-09 00:20:57 -04:00
}
| DependSingle {
file :: FilePath,
nsfw :: Bool,
output :: Maybe FilePath,
buildDir :: FilePath,
dataDir :: FilePath
}
deriving Show
2020-07-09 00:20:57 -04:00
optionsParser :: Opt.ParserInfo Options
2020-07-12 23:01:57 -04:00
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
2020-07-12 23:01:57 -04:00
2020-07-09 00:20:57 -04:00
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
singleOpts = SinglePage <$> file <*> nsfwS <*> output
file = Opt.strArgument $
2020-07-09 00:20:57 -04:00
Opt.metavar "FILE" <> Opt.help "yaml file to read"
nsfwS = Opt.switch $
2020-07-09 00:20:57 -04:00
Opt.short 'n' <> Opt.long "nsfw" <>
Opt.help "include nsfw versions"
output = Opt.option (Just <$> Opt.str) $
2020-07-12 23:00:46 -04:00
Opt.short 'o' <> Opt.long "output" <> Opt.metavar "FILE" <>
2020-07-09 00:20:57 -04:00
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 $
2020-07-12 23:00:46 -04:00
Opt.metavar "FILE..." <> Opt.help "yaml files to read"
nsfwG = Opt.switch $
2020-07-12 23:00:46 -04:00
Opt.short 'n' <> Opt.long "nsfw" <>
Opt.help "include works with no sfw versions"
2020-07-09 00:20:57 -04:00
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"
2020-07-09 00:20:57 -04:00
mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc
2020-07-07 18:21:08 -04:00
main :: IO ()
2020-07-12 23:01:57 -04:00
main = do
opts <- Opt.execParser optionsParser
2020-07-15 05:43:57 -04:00
printV opts $ "options" :- opts
2020-07-12 23:01:57 -04:00
main2 opts
2020-07-09 00:20:57 -04:00
main2 :: Options -> IO ()
2020-07-13 02:32:59 -04:00
main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do
2020-07-12 23:01:57 -04:00
info <- readYAML file
2020-07-15 05:43:57 -04:00
printV opts $ "contents" :- info
2020-07-13 02:32:59 -04:00
let page = make nsfw info
writeOutput output page
2020-07-12 23:01:57 -04:00
main2 (Options {mode = GalleryPage {}}) = do
2020-07-09 00:20:57 -04:00
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
2020-07-15 05:43:57 -04:00
printV :: Show a => Options -> a -> IO ()
printV (Options {verbose}) x =
when verbose $ hPutStrLn stderr $
#ifdef PRETTY_VERBOSE
ppShow x
#else
show x
#endif
2020-07-12 23:01:57 -04:00
readYAML :: YAML.FromYAML a => FilePath -> IO a
2020-07-12 23:01:57 -04:00
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
2020-07-15 05:43:57 -04:00
writeOutput :: Maybe FilePath -> Text -> IO ()
writeOutput (Just f) = Text.writeFile f
writeOutput Nothing = Text.putStrLn
data Tag a = String :- a deriving Show