gallery/make-pages/Main.hs

98 lines
3 KiB
Haskell
Raw Normal View History

2020-07-07 18:21:08 -04:00
module Main (main) where
import qualified Data.ByteString.Lazy as ByteString
2020-07-12 23:01:57 -04:00
import Data.ByteString.Lazy (ByteString)
import qualified Data.YAML as YAML
import qualified Data.Text.Lazy.IO as Text
2020-07-09 00:20:57 -04:00
import qualified Options.Applicative as Opt
2020-07-12 23:01:57 -04:00
import System.IO (hPrint, stderr)
import Text.Printf (printf)
2020-07-09 00:20:57 -04:00
import Control.Applicative
2020-07-12 23:01:57 -04:00
import Control.Monad
2020-07-09 00:20:57 -04:00
import SinglePage
data Options =
2020-07-12 23:01:57 -04:00
Options {
verbose :: Bool,
mode :: ModeOptions
}
deriving Show
data ModeOptions =
2020-07-09 00:20:57 -04:00
SinglePage {
file :: FilePath,
includeNsfw :: Bool,
2020-07-12 23:40:46 -04:00
output :: Maybe FilePath
2020-07-09 00:20:57 -04:00
}
| GalleryPage {
2020-07-12 23:00:46 -04:00
files :: [FilePath],
2020-07-09 00:20:57 -04:00
includeNsfw :: Bool,
2020-07-12 23:00:46 -04:00
output :: Maybe FilePath
2020-07-09 00:20:57 -04:00
}
deriving Show
2020-07-09 00:20:57 -04:00
optionsParser :: Opt.ParserInfo Options
2020-07-12 23:01:57 -04:00
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)
2020-07-09 00:20:57 -04:00
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
2020-07-12 23:40:46 -04:00
singleOpts = SinglePage <$> fileArg <*> nsfwSwitchS <*> outputOpt
2020-07-09 00:20:57 -04:00
fileArg = Opt.strArgument $
Opt.metavar "FILE" <> Opt.help "yaml file to read"
2020-07-12 23:00:46 -04:00
nsfwSwitchS = Opt.switch $
2020-07-09 00:20:57 -04:00
Opt.short 'n' <> Opt.long "nsfw" <>
Opt.help "include nsfw versions"
outputOpt = Opt.option (Just <$> Opt.str) $
2020-07-12 23:00:46 -04:00
Opt.short 'o' <> Opt.long "output" <> Opt.metavar "FILE" <>
2020-07-09 00:20:57 -04:00
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
2020-07-12 23:00:46 -04:00
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"
2020-07-09 00:20:57 -04:00
galleryInfo = Opt.progDesc "generate a gallery page"
mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc
2020-07-07 18:21:08 -04:00
main :: IO ()
2020-07-12 23:01:57 -04:00
main = do
opts <- Opt.execParser optionsParser
printVerbose opts opts
main2 opts
2020-07-09 00:20:57 -04:00
main2 :: Options -> IO ()
2020-07-12 23:01:57 -04:00
main2 (Options {mode = SinglePage {file, includeNsfw, output}}) = do
info <- readYAML file
print info
let page = make includeNsfw info
2020-07-09 00:20:57 -04:00
case output of
Nothing -> Text.putStr page
Just out -> Text.writeFile out page
2020-07-12 23:01:57 -04:00
main2 (Options {mode = GalleryPage {}}) = do
2020-07-09 00:20:57 -04:00
error "surprise! this doesn't exist yet"
2020-07-12 23:01:57 -04:00
printVerbose :: Show a => Options -> a -> IO ()
printVerbose (Options {verbose}) x = when verbose $ hPrint stderr x
readYAML :: YAML.FromYAML a => FilePath -> IO a
2020-07-12 23:01:57 -04:00
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