gallery/make-pages/Main.hs

82 lines
2.5 KiB
Haskell

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