gallery/make-pages/Main.hs

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