add some extra stuff to main that doesnt do anything yet

This commit is contained in:
Rhiannon Morris 2020-07-12 05:41:07 +02:00
parent de160967e8
commit bf6308de32

View file

@ -4,6 +4,7 @@ import qualified Data.ByteString.Lazy as ByteString
import qualified Data.YAML as YAML import qualified Data.YAML as YAML
import qualified Data.Text.Lazy.IO as Text import qualified Data.Text.Lazy.IO as Text
import qualified Options.Applicative as Opt import qualified Options.Applicative as Opt
import Text.Printf (printf)
import Control.Applicative import Control.Applicative
import SinglePage import SinglePage
@ -11,20 +12,23 @@ data Options =
SinglePage { SinglePage {
file :: FilePath, file :: FilePath,
includeNsfw :: Bool, includeNsfw :: Bool,
output :: Maybe FilePath output :: Maybe FilePath,
copyImages :: Bool
} }
| GalleryPage { | GalleryPage {
directory :: FilePath, directory :: FilePath,
includeNsfw :: Bool, includeNsfw :: Bool,
output :: Maybe FilePath output :: Maybe FilePath,
single :: Bool
} }
deriving Show
optionsParser :: Opt.ParserInfo Options optionsParser :: Opt.ParserInfo Options
optionsParser = optionsParser =
(Opt.hsubparser (single <> gallery) <**> Opt.helper) `Opt.info` mainInfo (Opt.hsubparser (single <> gallery) <**> Opt.helper) `Opt.info` mainInfo
where where
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
singleOpts = SinglePage <$> fileArg <*> nsfwSwitch <*> outputOpt singleOpts = SinglePage <$> fileArg <*> nsfwSwitch <*> outputOpt <*> copyOpt
fileArg = Opt.strArgument $ fileArg = Opt.strArgument $
Opt.metavar "FILE" <> Opt.help "yaml file to read" Opt.metavar "FILE" <> Opt.help "yaml file to read"
nsfwSwitch = Opt.switch $ nsfwSwitch = Opt.switch $
@ -34,12 +38,19 @@ optionsParser =
Opt.short 'o' <> Opt.long "output" <> Opt.short 'o' <> Opt.long "output" <>
Opt.value Nothing <> Opt.value Nothing <>
Opt.help "output file (default: stdout)" 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" singleInfo = Opt.progDesc "generate a page for a single work"
gallery = Opt.command "gallery" $ galleryOpts `Opt.info` galleryInfo gallery = Opt.command "gallery" $ galleryOpts `Opt.info` galleryInfo
galleryOpts = GalleryPage <$> dirArg <*> nsfwSwitch <*> outputOpt galleryOpts =
GalleryPage <$> dirArg <*> nsfwSwitch <*> outputOpt <*> singleOpt
dirArg = Opt.strArgument $ dirArg = Opt.strArgument $
Opt.metavar "DIR" <> Opt.help "directory to search for yaml files" 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" galleryInfo = Opt.progDesc "generate a gallery page"
mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc mainInfo = Opt.progDesc "static gallery site generator" <> Opt.fullDesc
@ -51,12 +62,20 @@ main = main2 =<< Opt.execParser optionsParser
main2 :: Options -> IO () main2 :: Options -> IO ()
main2 s@(SinglePage {file, includeNsfw, output}) = do main2 s@(SinglePage {file, includeNsfw, output}) = do
print s print s
txt <- ByteString.readFile file page <- make includeNsfw <$> readYAML file
let Right info = YAML.decode1 txt
let page = make includeNsfw info
case output of case output of
Nothing -> Text.putStr page Nothing -> Text.putStr page
Just out -> Text.writeFile out page Just out -> Text.writeFile out page
main2 g@(GalleryPage {}) = do main2 g@(GalleryPage {}) = do
print g print g
error "surprise! this doesn't exist yet" 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