add some extra stuff to main that doesnt do anything yet
This commit is contained in:
parent
de160967e8
commit
bf6308de32
1 changed files with 26 additions and 7 deletions
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue