2020-07-07 18:21:08 -04:00
|
|
|
module Main (main) where
|
|
|
|
|
2020-07-07 23:28:20 -04:00
|
|
|
import qualified Data.ByteString.Lazy as ByteString
|
2020-07-12 23:01:57 -04:00
|
|
|
import Data.ByteString.Lazy (ByteString)
|
2020-07-07 23:28:20 -04:00
|
|
|
import qualified Data.YAML as YAML
|
|
|
|
import qualified Data.Text.Lazy.IO as Text
|
2020-07-09 00:20:57 -04:00
|
|
|
import qualified Options.Applicative as Opt
|
2020-07-12 23:01:57 -04:00
|
|
|
import System.IO (hPrint, stderr)
|
2020-07-11 23:41:07 -04:00
|
|
|
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
|
|
|
|
|
|
|
|
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 {
|
|
|
|
file :: FilePath,
|
|
|
|
includeNsfw :: Bool,
|
2020-07-12 23:40:46 -04:00
|
|
|
output :: Maybe FilePath
|
2020-07-09 00:20:57 -04:00
|
|
|
}
|
|
|
|
| GalleryPage {
|
2020-07-12 23:00:46 -04:00
|
|
|
files :: [FilePath],
|
2020-07-09 00:20:57 -04:00
|
|
|
includeNsfw :: Bool,
|
2020-07-12 23:00:46 -04:00
|
|
|
output :: Maybe FilePath
|
2020-07-09 00:20:57 -04:00
|
|
|
}
|
2020-07-11 23:41:07 -04:00
|
|
|
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)
|
|
|
|
|
2020-07-09 00:20:57 -04:00
|
|
|
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
|
2020-07-12 23:40:46 -04:00
|
|
|
singleOpts = SinglePage <$> fileArg <*> nsfwSwitchS <*> outputOpt
|
2020-07-09 00:20:57 -04:00
|
|
|
fileArg = Opt.strArgument $
|
|
|
|
Opt.metavar "FILE" <> Opt.help "yaml file to read"
|
2020-07-12 23:00:46 -04:00
|
|
|
nsfwSwitchS = Opt.switch $
|
2020-07-09 00:20:57 -04:00
|
|
|
Opt.short 'n' <> Opt.long "nsfw" <>
|
|
|
|
Opt.help "include nsfw versions"
|
|
|
|
outputOpt = 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
|
2020-07-12 23:00:46 -04:00
|
|
|
galleryOpts = GalleryPage <$> filesArg <*> nsfwSwitchG <*> outputOpt
|
|
|
|
filesArg = many $ Opt.strArgument $
|
|
|
|
Opt.metavar "FILE..." <> Opt.help "yaml files to read"
|
|
|
|
nsfwSwitchG = Opt.switch $
|
|
|
|
Opt.short 'n' <> Opt.long "nsfw" <>
|
|
|
|
Opt.help "include works with only nsfw versions"
|
2020-07-09 00:20:57 -04:00
|
|
|
galleryInfo = Opt.progDesc "generate a gallery page"
|
|
|
|
|
|
|
|
mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc
|
|
|
|
|
2020-07-07 23:28:20 -04:00
|
|
|
|
2020-07-07 18:21:08 -04:00
|
|
|
main :: IO ()
|
2020-07-12 23:01:57 -04:00
|
|
|
main = do
|
|
|
|
opts <- Opt.execParser optionsParser
|
|
|
|
printVerbose opts opts
|
|
|
|
main2 opts
|
2020-07-09 00:20:57 -04:00
|
|
|
|
|
|
|
main2 :: Options -> IO ()
|
2020-07-13 02:30:25 -04:00
|
|
|
main2 opts@(Options {mode = SinglePage {file, includeNsfw, output}}) = do
|
2020-07-12 23:01:57 -04:00
|
|
|
info <- readYAML file
|
2020-07-13 02:30:25 -04:00
|
|
|
printVerbose opts info
|
2020-07-12 23:01:57 -04:00
|
|
|
let page = make includeNsfw info
|
2020-07-09 00:20:57 -04:00
|
|
|
case output of
|
|
|
|
Nothing -> Text.putStr page
|
|
|
|
Just out -> Text.writeFile out page
|
2020-07-11 23:41:07 -04:00
|
|
|
|
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"
|
2020-07-11 23:41:07 -04:00
|
|
|
|
|
|
|
|
2020-07-12 23:01:57 -04:00
|
|
|
printVerbose :: Show a => Options -> a -> IO ()
|
|
|
|
printVerbose (Options {verbose}) x = when verbose $ hPrint stderr x
|
|
|
|
|
2020-07-11 23:41:07 -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 =
|
2020-07-11 23:41:07 -04:00
|
|
|
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
|