make separate options module, etc

This commit is contained in:
Rhiannon Morris 2020-07-15 20:06:19 +02:00
parent 74f2e30955
commit 849d893b86
3 changed files with 123 additions and 90 deletions

View file

@ -1,4 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP, ImplicitParams #-}
module Main (main) where
import qualified Data.ByteString.Lazy as ByteString
@ -6,12 +6,12 @@ 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 Options
import SinglePage
import Depend
@ -20,107 +20,37 @@ 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
type HasVerbose = (?verbose :: Bool)
main :: IO ()
main = do
opts <- Opt.execParser optionsParser
printV opts $ "options" :- opts
main2 opts
opts@(Options {verbose, mode}) <- parseOptions
let ?verbose = verbose
printV $ "options" :- opts
main2 mode
main2 :: Options -> IO ()
main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do
main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {file, nsfw, output}) = do
info <- readYAML file
printV opts $ "contents" :- info
printV $ "contents" :- info
let page = make nsfw info
writeOutput output page
main2 (Options {mode = GalleryPage {}}) = do
main2 (GalleryPage {}) = do
error "surprise! this doesn't exist yet"
main2 opts@(Options
{mode = DependSingle {file, nsfw, output, buildDir, dataDir}}) = do
main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do
info <- readYAML file
printV opts $ "contents" :- info
printV $ "contents" :- info
let path = makeRelative dataDir file
printV opts $ "path" :- path
let deps = dependSingle' path info buildDir nsfw
printV $ "path" :- path
let deps = dependSingle' path info prefix buildDir nsfw
writeOutput output deps
printV :: Show a => Options -> a -> IO ()
printV (Options {verbose}) x = when verbose $ hPrint stderr x
printV :: (Show a, HasVerbose) => a -> IO ()
printV x = when ?verbose $ hPrint stderr x
readYAML :: YAML.FromYAML a => FilePath -> IO a
readYAML file = ByteString.readFile file >>= decode1Must file

102
make-pages/Options.hs Normal file
View file

@ -0,0 +1,102 @@
module Options where
import Info
import Options.Applicative
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,
prefix :: FilePath,
buildDir :: FilePath,
dataDir :: FilePath
}
deriving Show
data Who = Mine | NotMine | All deriving (Eq, Show)
readWho :: String -> Maybe Who
readWho "mine" = Just Mine
readWho "not-mine" = Just NotMine
readWho "all" = Just All
readWho _ = Nothing
matchWho :: Who -> Info -> Bool
matchWho Mine = #mine
matchWho NotMine = #notMine
matchWho _ = const True
optionsParser :: ParserInfo Options
optionsParser = globalOpts `info` mainInfo where
globalOpts = Options <$> verboseOpt <*> subcommands <**> helper
verboseOpt = switch $
short 'v' <> long "verbose" <>
help "print extra stuff to stderr"
subcommands = hsubparser $
single <> gallery <> dependSingle
single = command "single" $ singleOpts `info` singleInfo
singleOpts = SinglePage <$> file <*> nsfwS <*> output
file = strArgument $
metavar "FILE" <> help "yaml file to read"
nsfwS = switch $
short 'n' <> long "nsfw" <>
help "include nsfw versions"
output = option (Just <$> str) $
short 'o' <> long "output" <> metavar "FILE" <>
value Nothing <>
help "output file (default: stdout)"
singleInfo = progDesc "generate a page for a single work"
gallery = command "gallery" $ galleryOpts `info` galleryInfo
galleryOpts = GalleryPage <$> files <*> nsfwG <*> output
files = many $ strArgument $
metavar "FILE..." <> help "yaml files to read"
nsfwG = switch $
short 'n' <> long "nsfw" <>
help "include works with no sfw versions"
galleryInfo = progDesc "generate a gallery page"
dependSingle = command "depend-single" $ dsOpts `info` dsInfo
dsOpts =
DependSingle <$> file <*> nsfwS <*> output <*> prefix
<*> buildDir <*> dataDir
prefix = strOption $
short 'p' <> long "prefix" <> metavar "DIR" <>
value "" <>
help "output directory prefix"
buildDir = strOption $
short 'B' <> long "build-dir" <> metavar "DIR" <>
value "_build" <>
help "build directory (default: _build)"
dataDir = strOption $
short 'D' <> long "data-dir" <> metavar "DIR" <>
value "data" <>
help "data directory (default: data)"
dsInfo = progDesc "generate makefile dependencies for a single page"
mainInfo = progDesc "static gallery site generator" <> fullDesc
parseOptions :: IO Options
parseOptions = execParser optionsParser

View file

@ -18,16 +18,17 @@ executable make-pages
BuildVar,
Info,
SinglePage,
Depend
Depend,
Options
default-language: Haskell2010
default-extensions:
BlockArguments,
ConstraintKinds,
DataKinds,
DeriveAnyClass,
DerivingStrategies,
DuplicateRecordFields,
FlexibleInstances,
LambdaCase,
NamedFieldPuns,
OverloadedLabels,
OverloadedStrings,