From 849d893b862f7df01cfcb0f7093e0f030172dea1 Mon Sep 17 00:00:00 2001 From: Rhiannon Morris Date: Wed, 15 Jul 2020 20:06:19 +0200 Subject: [PATCH] make separate options module, etc --- make-pages/Main.hs | 106 ++++++------------------------------ make-pages/Options.hs | 102 ++++++++++++++++++++++++++++++++++ make-pages/make-pages.cabal | 5 +- 3 files changed, 123 insertions(+), 90 deletions(-) create mode 100644 make-pages/Options.hs diff --git a/make-pages/Main.hs b/make-pages/Main.hs index 171958b..f174a76 100644 --- a/make-pages/Main.hs +++ b/make-pages/Main.hs @@ -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 diff --git a/make-pages/Options.hs b/make-pages/Options.hs new file mode 100644 index 0000000..cbd884c --- /dev/null +++ b/make-pages/Options.hs @@ -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 diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal index 2744d4b..a74dccb 100644 --- a/make-pages/make-pages.cabal +++ b/make-pages/make-pages.cabal @@ -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,