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