diff --git a/make-pages/Main.hs b/make-pages/Main.hs index bf52cbd..507851c 100644 --- a/make-pages/Main.hs +++ b/make-pages/Main.hs @@ -1,14 +1,24 @@ module Main (main) where import qualified Data.ByteString.Lazy as ByteString +import Data.ByteString.Lazy (ByteString) import qualified Data.YAML as YAML import qualified Data.Text.Lazy.IO as Text import qualified Options.Applicative as Opt +import System.IO (hPrint, stderr) import Text.Printf (printf) import Control.Applicative +import Control.Monad import SinglePage data Options = + Options { + verbose :: Bool, + mode :: ModeOptions + } + deriving Show + +data ModeOptions = SinglePage { file :: FilePath, includeNsfw :: Bool, @@ -23,9 +33,13 @@ data Options = deriving Show optionsParser :: Opt.ParserInfo Options -optionsParser = - (Opt.hsubparser (single <> gallery) <**> Opt.helper) `Opt.info` mainInfo - where +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) + single = Opt.command "single" $ singleOpts `Opt.info` singleInfo singleOpts = SinglePage <$> fileArg <*> nsfwSwitchS <*> outputOpt <*> copyOpt fileArg = Opt.strArgument $ @@ -55,24 +69,32 @@ optionsParser = main :: IO () -main = main2 =<< Opt.execParser optionsParser +main = do + opts <- Opt.execParser optionsParser + printVerbose opts opts + main2 opts main2 :: Options -> IO () -main2 s@(SinglePage {file, includeNsfw, output}) = do - print s - page <- make includeNsfw <$> readYAML file +main2 (Options {mode = SinglePage {file, includeNsfw, output}}) = do + info <- readYAML file + print info + let page = make includeNsfw info case output of Nothing -> Text.putStr page Just out -> Text.writeFile out page -main2 g@(GalleryPage {}) = do - print g +main2 (Options {mode = GalleryPage {}}) = do error "surprise! this doesn't exist yet" +printVerbose :: Show a => Options -> a -> IO () +printVerbose (Options {verbose}) x = when verbose $ hPrint stderr x + readYAML :: YAML.FromYAML a => FilePath -> IO a -readYAML file = do - txt <- ByteString.readFile file +readYAML file = ByteString.readFile file >>= decode1Must file + +decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a +decode1Must file txt = case YAML.decode1 txt of Right val -> pure val Left (YAML.Pos {posLine, posColumn}, err) ->