make separate options module, etc

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

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

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,