{-# LANGUAGE CPP #-} module Main (main) where import qualified Data.ByteString.Lazy as ByteString import Data.ByteString.Lazy (ByteString) import qualified Data.YAML as YAML import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.IO as Text import qualified Options.Applicative as Opt import System.IO (hPrint, stderr) import System.FilePath (makeRelative) import Text.Printf (printf) import Control.Applicative import Control.Monad import SinglePage import Depend #ifdef PRETTY_VERBOSE import qualified Text.Show.Pretty as PP import qualified Text.PrettyPrint as PP #endif 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 } | DependSingle { file :: FilePath, nsfw :: Bool, output :: Maybe FilePath, buildDir :: FilePath, dataDir :: 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 <> dependSingle single = Opt.command "single" $ singleOpts `Opt.info` singleInfo singleOpts = SinglePage <$> file <*> nsfwS <*> output file = Opt.strArgument $ Opt.metavar "FILE" <> Opt.help "yaml file to read" nsfwS = Opt.switch $ Opt.short 'n' <> Opt.long "nsfw" <> Opt.help "include nsfw versions" output = 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 <$> files <*> nsfwG <*> output files = many $ Opt.strArgument $ Opt.metavar "FILE..." <> Opt.help "yaml files to read" nsfwG = Opt.switch $ Opt.short 'n' <> Opt.long "nsfw" <> Opt.help "include works with no sfw versions" galleryInfo = Opt.progDesc "generate a gallery page" dependSingle = Opt.command "depend-single" $ dsOpts `Opt.info` dsInfo dsOpts = DependSingle <$> file <*> nsfwS <*> output <*> buildDir <*> dataDir buildDir = Opt.strOption $ Opt.short 'B' <> Opt.long "build-dir" <> Opt.metavar "DIR" <> Opt.value "_build" <> Opt.help "build directory (default: _build)" dataDir = Opt.strOption $ Opt.short 'D' <> Opt.long "data-dir" <> Opt.metavar "DIR" <> Opt.value "data" <> Opt.help "data directory (default: data)" dsInfo = Opt.progDesc "generate makefile dependencies for a single page" mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc main :: IO () main = do opts <- Opt.execParser optionsParser printV opts $ "options" :- opts main2 opts main2 :: Options -> IO () main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do info <- readYAML file printV opts $ "contents" :- info let page = make nsfw info writeOutput output page main2 (Options {mode = GalleryPage {}}) = do error "surprise! this doesn't exist yet" main2 opts@(Options {mode = DependSingle {file, nsfw, output, buildDir, dataDir}}) = do info <- readYAML file printV opts $ "contents" :- info let path = makeRelative dataDir file printV opts $ "path" :- path let deps = dependSingle' path info buildDir nsfw writeOutput output deps printV :: Show a => Options -> a -> IO () printV (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 writeOutput :: Maybe FilePath -> Text -> IO () writeOutput (Just f) = Text.writeFile f writeOutput Nothing = Text.putStrLn data Tag a = String :- a instance Show a => Show (Tag a) where show (tag :- a) = #ifdef PRETTY_VERBOSE PP.render $ PP.hang (PP.text tag <> ":") 2 (PP.ppDoc a) #else tag ++ ": " ++ show a #endif