gallery/make-pages/Main.hs

97 lines
3 KiB
Haskell

module Main (main) where
import qualified Data.ByteString.Lazy as ByteString
import Data.ByteString.Lazy (ByteString)
import qualified Data.YAML as YAML
import qualified Data.Text.Lazy.IO as Text
import qualified Options.Applicative as Opt
import System.IO (hPrint, stderr)
import Text.Printf (printf)
import Control.Applicative
import Control.Monad
import SinglePage
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
}
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)
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
singleOpts = SinglePage <$> fileArg <*> nsfwSwitchS <*> outputOpt
fileArg = Opt.strArgument $
Opt.metavar "FILE" <> Opt.help "yaml file to read"
nsfwSwitchS = Opt.switch $
Opt.short 'n' <> Opt.long "nsfw" <>
Opt.help "include nsfw versions"
outputOpt = 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 $
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"
galleryInfo = Opt.progDesc "generate a gallery page"
mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc
main :: IO ()
main = do
opts <- Opt.execParser optionsParser
printVerbose opts opts
main2 opts
main2 :: Options -> IO ()
main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do
info <- readYAML file
printVerbose opts info
let page = make nsfw info
case output of
Nothing -> Text.putStr page
Just out -> Text.writeFile out page
main2 (Options {mode = GalleryPage {}}) = do
error "surprise! this doesn't exist yet"
printVerbose :: Show a => Options -> a -> IO ()
printVerbose (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