gallery/make-pages/Main.hs

module Main (main) where

import qualified Data.ByteString.Lazy as ByteString
import qualified Data.YAML as YAML
import qualified Data.Text.Lazy.IO as Text
import qualified Options.Applicative as Opt
import Text.Printf (printf)
import Control.Applicative
import SinglePage

data Options =
    SinglePage {
      file        :: FilePath,
      includeNsfw :: Bool,
      output      :: Maybe FilePath,
      copyImages  :: Bool
    }
  | GalleryPage {
      directory   :: FilePath,
      includeNsfw :: Bool,
      output      :: Maybe FilePath,
      single      :: Bool
    }
  deriving Show

optionsParser :: Opt.ParserInfo Options
optionsParser =
  (Opt.hsubparser (single <> gallery) <**> Opt.helper) `Opt.info` mainInfo
 where
  single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
  singleOpts = SinglePage <$> fileArg <*> nsfwSwitch <*> outputOpt <*> copyOpt
  fileArg = Opt.strArgument $
    Opt.metavar "FILE" <> Opt.help "yaml file to read"
  nsfwSwitch = 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.value Nothing <>
    Opt.help "output file (default: stdout)"
  copyOpt = Opt.switch $
    Opt.short 'c' <> Opt.long "copy" <>
    Opt.help "copy mentioned image files to output directory"
  singleInfo = Opt.progDesc "generate a page for a single work"

  gallery = Opt.command "gallery" $ galleryOpts `Opt.info` galleryInfo
  galleryOpts =
    GalleryPage <$> dirArg <*> nsfwSwitch <*> outputOpt <*> singleOpt
  dirArg = Opt.strArgument $
    Opt.metavar "DIR" <> Opt.help "directory to search for yaml files"
  singleOpt = fmap not $ Opt.switch $
    Opt.short 'S' <> Opt.long "exclude-single" <>
    Opt.help "do not generate single pages"
  galleryInfo = Opt.progDesc "generate a gallery page"

  mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc


main :: IO ()
main = main2 =<< Opt.execParser optionsParser

main2 :: Options -> IO ()
main2 s@(SinglePage {file, includeNsfw, output}) = do
  print s
  page <- make includeNsfw <$> readYAML file
  case output of
    Nothing  -> Text.putStr page
    Just out -> Text.writeFile out page

main2 g@(GalleryPage {}) = do
  print g
  error "surprise! this doesn't exist yet"


readYAML :: YAML.FromYAML a => FilePath -> IO a
readYAML file = do
  txt <- ByteString.readFile file
  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